This sample was Assembled and tested during April 2002 on an OS/390 V2.R9 system.
PRINT NOGEN
TITLE 'EX4 - EXERCISE IN BINARY ARITHMETIC'
EX4 CSECT
USING *,R15 INITIAL BASE REGISTER
BEGIN B START
DC AL1(8),CL8'EX4' PROGRAM NAME FOR DEBUGGING
*--------P-O-S-I-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-E-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)
EJECT
*
* PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
SR R4,R4 R4 = CLEARED FOR ARITHMATIC
SR R10,R10
SR R11,R11
READREC GET INDCB,INAREA READ A RECORD
PACK DWORD,AMOUNT TRANSLATE
CVB R4,DWORD INTERNAL NUMERIC
AR R11,R4 ACUMULATE IN R10 AND
B READREC REPEAT TILL FILE EXHAUSTED
SPACE 1
READDONE LR R5,R11 SAVE ACCUMULATED TOTAL
*
* CONVERT AND PRINT THE TOTAL VALUE.
*
CVD R11,DWORD TRANSLATE TO
UNPK PTOT,DWORD+6(2) EXTERNAL
OI PTOT+2,X'F0' FORM
*
* CONVERT AND PRINT THE NET AMOUNT WITH DECIMAL PLACES.
*
M R10,=F'100000' CALCULATE
D R10,=F'1175' NET AMOUNT
CVD R11,DWORD TRANSLATE
UNPK PAMNT,DWORD+5(3) TO
MVC PAMNT(2),PAMNT+1 EXTERNAL
MVI PAMNT+2,C'.' PRINTABLE
OI PAMNT+4,X'F0' FORM
*
* CONVERT AND PRINT AMOUNT OF VAT WITH DECIMALS
*
M R4,=F'100' CALCULATE
SR R5,R11 FOR VAT
CVD R5,DWORD TRANSLATE TO
UNPK PDISC,DWORD+5(3) EXTERNAL
OI PDISC+4,X'F0' FORM
MVC PDISC(2),PDISC+1
MVI PDISC+2,C'.'
PUT OUTDCB,OUTREC WRITE LINE TO PRINTER
SPACE 3
EXIT CLOSE (INDCB,,OUTDCB) CLOSE BOTH FILES
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 (z/OS)
EJECT
LTORG
SPACE 1
DWORD DS 0D,PL8 WORK AREA FOR MATHS.
WREGS DC AL4(*-*),AL4(*-*) SAVE RESULTS OF DISCOUNT
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-E-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-I-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-E-N-T----C-O-D-E----*
OUTREC DS 0C OVERLAY FOR OUTPUT RECORD *
DC CL2' ' *
DC C'TOTAL = ' *
PTOT DC CL3' ' *
DC C' LESS V.A.T. AT 17.5% ' *
PDISC DC CL5' ' *
DC C' NET AMOUNT ' *
PAMNT DC CL5' ' *
DC CL76' ' *
OUTRECE DS 0C END OF OUTPUT RECORD *
ORL EQU OUTRECE-OUTREC LENGTH OF OUTPUT RECORD *
*-------------------------------------------------------------------*
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