This sample was Assembled and tested during July 2003 on a z/OS V1.R3 system. It is designed to demonstrate how an array with variable length fields could be built, and processed.
In this example the array was to contain no more than 14 rows, each holding a name of up to 8 characters, and a two-byte packed amount. The table was to be created from a small input file, and then processed to compute various values.
PRINT NOGEN
WSHOP41 CSECT
USING *,R15 INITIAL BASE REGISTER
BEGIN B START
DC AL1(8),CL8'WSHOP41' PROGRAM NAME FOR DEBUGGING
*----P-O-S-I-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E----------*
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 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) OPEN THE FILES
LA R9,INTAB R9 = DATA TABLE ADDRESS
USING INROW,R9 MAKE ROWS ADDRESSABLE
EJECT
*
* PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
READREC GET INDCB,INAREA READ A RECORD
*
* ADD THE RETRIEVED NAME TO THE ARRAY.
*
LA R1,INAREA+8 SET DEFAULT END OF NAME
TRT INAREA,FINDTAB LOOK FOR END OF NAME.
S R1,INADDR CALCULATE LENGTH OF NAME.
LR R15,R1 POINT TO
LA R15,2(R15,R9) ROW AMOUNT FIELD.
STCM R1,3,NAMELEN SAVE NAME LENGTH IN ROW.
BCTR R1,0 ADJUST LENGTH AND
EX R1,GETNAME SAVE NAME.
PACK 0(L'ROWAMNT,R15),AMOUNT SAVE THE AMOUNT.
AP PAYEES,=PL1'1' INCREMENT NUMBER OF PAYEES.
LA R9,2(0,R15) POINT TO NEXT ROW?
B READREC AND REPEAT TILL FILE EXHAUSTED.
GETNAME MVC ROWNAME(0),INAREA ACTUAL NAME SAVE INSTRUCTION.
SPACE 1
READDONE BAS R11,PROCTAB GO PROCESS THE TABLE.
*
* CONVERT AND PRINT THE TOTAL VALUE.
*
SRP TOTAL,2,0 CONVERT TO STERLING
EDMK PTOTAL,TOTAL PRINT THE TOTAL.
BCTR R1,0 INSERT CURRENCY
MVI 0(R1),C'$' SYMBOL
*
* CONVERT AND PRINT THE NET AMOUNT WITH DECIMAL PLACES.
*
ZAP AMNT,TOTAL CALCULATE
SRP AMNT,3,0 THE
DP AMNT,=PL3'1175' NET
EDMK PAMNT,AMNT PRINT THE DISCOUNT.
BCTR R1,0 INSERT CURRENCY
MVI 0(R1),C'$' SYMBOL
*
* CONVERT AND PRINT VAT AMOUNT WITH DECIMALS.
*
ZAP DISC,TOTAL CALCULATE
* SRP DISC,3,0 THE
SP DISC,AMNT(3) THE VAT.
EDMK PDISC,DISC PRINT THE AMOUNT.
BCTR R1,0 INSERT CURRENCY
MVI 0(R1),C'$' SYMBOL
ZAP AVERAGE,TOTAL
DP AVERAGE,PAYEES
EDMK PAV,AVERAGE
BCTR R1,0
MVI 0(R1),C'$'
PUT OUTDCB,PLINE2 WRITE LINE TO PRINTER.
PUT OUTDCB,PLINE3 WRITE LINE TO PRINTER.
SPACE 3
EXIT CLOSE (INDCB,,OUTDCB)
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
*
* NOW PROCESS THE ARRAY AS INPUT FOR THE CALCULATIONS.
*
PROCTAB LA R9,INTAB R9 = DATA TABLE ADDRESS
TABLOOP CLC =CL4'****',ROWNAME END OF TABLE?
BER R11 RETURN FROM WHENCE I CAME
LH R15,NAMELEN R15 = ROW NAME LENGTH
BCTR R15,0 PROCESS LENGTH AND
EX R15,PRTNAME GET NAME.
LA R15,3(R15,R9) POINT TO AMOUNT FIELD.
ED PRAMNT,0(R15) PUT AMOUNT IN PRINT LINE.
AP TOTAL,0(L'ROWAMNT,R15) ACCUMULATE TOTAL.
LA R9,2(0,R15) R9 = POINTS TO NEXT ROW.
PUT OUTDCB,PLINE1 PRINT THE TABLE ENTRY
MVC PNAME,PNAME-1 CLEAR THE NAME AND
MVC PRAMNT,=XL4'40202120' RESET AMOUNT FIELD.
B TABLOOP REPEAT TILL ACCUMULATED.
PRTNAME MVC PNAME(0),ROWNAME ACTUAL NAME SAVE INSTRUCTION.
LTORG
SPACE 1
TOTAL DC PL4'0' ACCUMULATED TOTAL.
DISC DC PL3'0' VALUE OF DISCOUNT.
AMNT DC PL6'0' TOTAL - DISC = AMNT
PWORK DC PL2'0' WORK AREA FOR PACKING.
PAYEES DC PL2'0' NUMBER OF PAYEES.
AVERAGE DC PL5'0' AVERAGE PAID PER PAYEE.
WREGS DC AL4(*-*),AL4(*-*) SAVE RESULTS OF DISCOUNT.
INADDR DC AL4(INAREA) ADDRESS OF INPUT AREA.
*----P-O-S-I-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E----------*
INTAB DS 0H TABLE HOLDING INPUT REC DATA *
DC 14XL12'0' 14 - 12-BYTE ROWS PROVIDED *
INROW DSECT INDIVIDUAL ROW OF TABLE *
NAMELEN DS AL2 LENGTH OF NAME FIELD *
ROWNAME DS CL8 VARIABLE LENGTH NAME *
ROWAMNT DS PL2 ASSOCIATED AMOUNT *
WSHOP41 CSECT *
*---------------------------------------------------------------------*
SPACE 1
INDCB DCB MACRF=GM,EODAD=READDONE,DDNAME=INDD,LRECL=80,DSORG=PS
*----P-O-S-I-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E----------*
INAREA DS 0CL80 *
NAME DC CL9' ' *
AMOUNT DC CL2' ' *
DS CL69 *
*---------------------------------------------------------------------*
SPACE 1
OUTDCB DCB MACRF=PM,RECFM=F,LRECL=133,DDNAME=OUTDD,DSORG=PS
*----P-O-S-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E------------*
PLINE1 DS 0C OVERLAY FOR OUTPUT RECORD. *
DC CL2' ' *
DC C'INPUT ROW NAME = ' *
PNAME DC CL8' ' PRINTED ROW NAME *
DC C' INPUT ROW AMOUNT =' *
PRAMNT DC XL4'40202120' PRINTED ROW AMOUNT *
DC CL77' ' *
PLINE1E DS 0C END OF OUTPUT RECORD *
PL1L EQU PLINE1E-PLINE1 LENGTH OF OUTPUT RECORD. *
*---------------------------------------------------------------------*
SPACE 1
*----P-O-S-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E------------*
PLINE2 DS 0C OVERLAY FOR OUTPUT RECORD. *
DC CL2' ' *
DC C'TOTAL =' *
PTOTAL DC XL9'4020202021204B2020' *
DC C' LESS VAT AT 17.5% ' *
PDISC DC XL7'402020214B2020' *
DC C' FINAL AMOUNT' *
PAMNT DC XL7'402020214B2020' *
DC CL1' ' *
DC CL67' ' *
PLINE2E DS 0C END OF OUTPUT RECORD *
PL2L EQU PLINE2E-PLINE2 LENGTH OF OUTPUT RECORD. *
*---------------------------------------------------------------------*
SPACE 1
*----P-O-S-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E------------*
PLINE3 DS 0C OVERLAY FOR OUTPUT RECORD. *
DC CL2' ' *
DC C'AVERAGE PAID PER PAYEE = ' *
PAV DC XL6'402020214B2020' *
DC CL100' ' *
PLINE3E DS 0C END OF OUTPUT RECORD *
PL3L EQU PLINE3E-PLINE3 LENGTH OF OUTPUT RECORD. *
*---------------------------------------------------------------------*
SPACE 1
*----P-O-S-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-A-N-T----C-O-D-E------------*
FINDTAB DC 256XL1'0' SEARCH TABLE *
ORG FINDTAB+C' ' LOOKING FOR *
DC C' ' A BLANK *
ORG , *
*---------------------------------------------------------------------*
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 2003