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

         PRINT NOGEN
         TITLE 'EX2 - SEQUENTIAL I/O AND SIMPLE ARRAY SAMPLE'
EX2      CSECT
         USING *,R15              INITIAL BASE REGISTER
BEGIN    B     START
         DC    AL1(8)
         DC    CL8'EX2'           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.
*
         LA    R4,OUTAREA+1       R4  = ADDR OF 1ST NAME SLOT.
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   0(8,R4),INAREA     NO  - INSERT NAME IN PRINTLINE
         LA    R4,8(,R4)          POINT TO NEXT NAME SLOT,
         B     READREC            AND REPEAT TILL EXHAUSTED.
         SPACE 3
READDONE PUT   OUTDCB,OUTAREA     WRITE LINE TO PRINTER, AND
EXIT     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