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