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

         PRINT NOGEN
READESDS CSECT
         USING *,R15                    INITIAL BASE REGISTER
BEGIN    B     START
         DC    AL1(8)
         DC    CL8'READESDS'            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
START    EQU   *
         DROP  R15                      LOOSE INITIAL BASE REGISTER
         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  (INACB,,OUTDCB,OUTPUT)   OPEN THE FILES.
         EJECT
*
*        PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
         LA    R4,OUTAREA+1             R4  = ADDR OF 1ST NAME SLOT.
READREC  GET   RPL=INRPL                READ A RECORD
*
*        ADD THE RETRIEVED NAME TO THE LIST.
*
         MVC   0(8,R4),INAREA           NO  - INSERT NAME IN PRINT LINE
         LA    R4,8(,R4)                POINT TO NEXT NAME SLOT,
         B     READREC                  AND REPEAT TILL FILE EXHAUSTED.
         SPACE 3
READDONE PUT   OUTDCB,OUTAREA           WRITE LINE TO PRINTER, AND
EXIT     CLOSE (INACB,,OUTDCB)          CLOSE THE INPUT FILE.
         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 (OS/390)
         EJECT
         LTORG
         SPACE 1
INACB    ACB   AM=VSAM,DDNAME=INDD,BUFND=5,MACRF=(SEQ,IN),EXLST=EXITS
INRPL    RPL   ACB=INACB,AM=VSAM,AREA=INAREA,AREALEN=80,                *
               OPTCD=(ADR,SEQ),RECLEN=80
EXITS    EXLST EODAD=(READDONE,A)
INAREA   DS    CL80
         SPACE 1
OUTDCB   DCB   MACRF=PM,RECFM=F,LRECL=133,DDNAME=OUTDD,DSORG=PS
OUTAREA  DC    CL133' '
         SPACE 1
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