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

         PRINT NOGEN
EX1      CSECT
         USING *,R15                   INITIAL BASE REGISTER
BEGIN    B     START
         DC    AL1(8)
         DC    CL8'EX1'                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
START    EQU   *
         DROP  R15                     DUMP 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  (INDCB,INPUT,OUTDCB,OUTPUT)
         EJECT
*
*        PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
READREC  GET   INDCB,INAREA            READ A RECORD
*
*        ADD THE RETRIEVED NAME TO THE LIST.
*
         CLC   =CL4'****',INAREA       IS IT LAST INPUT RECORD?
         BE    READDONE                YEP - STOP READING.
         MVC   OUTAREA,INAREA          NO  - INSERT NAME IN PRINTLINE
         PUT   OUTDCB,OUTAREA          WRITE LINE TO PRINTER, AND
         MVI   OUTAREA,C' '                           CLEAR
         MVC   OUTAREA+1(L'OUTAREA-1),OUTAREA 
         B     READREC                 AND REPEAT TILL EXHAUSTED.
         SPACE 3
READDONE CLOSE (INDCB,,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
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
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