This sample was Assembled and tested during May 2002 on an OS/390 V2.R9 system. It comprises two separate modules the executed code EX9, and a data only module (EX9MSGS) containing the message table.
The code represents a more sophisticated use of bit manipulation both in the setting and retrieval of flags to ensure that all messages associated with each byte of the number being validated are issued.
PRINT NOGEN
TITLE 'EX9 - EXERCISE USING MESSAGE TABLES'
EX9 CSECT
USING *,R15
INITIAL BASE REGISTER
BEGIN B START
DC AL1(8),CL8'EX9' 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 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.
LOAD EP=EX9MSGS LOAD MESSAGE TABLE, AND
ST R0,MSGADDR - - - -> SAVE MSG TABLE ADDR
OPEN (INDCB,INPUT,OUTDCB,OUTPUT)
EJECT
*
* PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
READREC GET INDCB,RECORD READ A RECORD
*
* ADD THE RETRIEVED NAME TO THE LIST.
*
MVC NUMFLGS,DEFAULTS APPLY DEFAULT FLAG SETTINGS.
LA R9,PAMOUNT-1 R9 = ADDR OF CHECK AREA
LA R8,3(0,0) R3 = NUMBER OF PASSES
BAS R11,NUMCHECK GO DO NUMERIC CHECK.
BAS R11,PUTIT OUTPUT TO FILE,
B READREC AND REPEAT TILL FILE EXHAUSTED.
SPACE 1
NUMCHECK LA R9,1(,R9) GET APPROPRIATE BYTE.
CH R8,=H'1' IS IT LAST BYTE?
BNH LASTBYTE NO - SKIP FLAG SET.
TM 0(R9),F IS IT X'FN'?
BO OK YEP - SKIP REST OF TEST.
B NOTOK NO - DETERMINE ERROR
LASTBYTE LA R7,6(0,0) SET VALID OPTIONS
LA R5,NUMOPTS POINT TO VALID OPTION LIST
LASTCHCK IC R6,0(R5) GET VALID OPTION.
EX R6,NUMTM EXECUTE NUMERIC CHECK
BO POSNEG YEP - CHECK PLUS OR MINUS
LA R5,1(,R5) REPEAT
BCT R7,LASTCHCK - - - -> TILL VETTED
OI NUMFLGS,BYTE3+NOTNUM INDICATE BYTE3 IN ERROR.
B NOTOK3 CONTINUE
NOTOK OI NUMFLGS,NOTNUM INDICATE NOT NUMERIC, AND
CH R8,=H'3' IS IT FIRST BYTE?
BL NOTOK2 NO - CHECK FOR SECOND
OI NUMFLGS,BYTE1 YEP - INDICATE 1ST BYTE ERROR.
B NOTOK3 CONTINUE
NOTOK2 OI NUMFLGS,BYTE2 IF NOT 1ST MUST BE 2ND
NOTOK3 NI NUMFLGS,X'FF'-POS SWITCH OFF POSITIVE INDICATOR.
OK BCT R8,NUMCHECK REPEAT TILL VETTED AND
BR R11 - - - -> ALL DONE.
POSNEG TM 0(R9),F IS IT DEFAULT ZONE F?
BO OK YEP - THEN POSITIVE
TM 0(R9),16 IS IT NEGATIVE?
BO NEGF YEP - SET FLAG.
B OK NO - MUST BE POSITIVE.
NEGF TM NUMFLGS,NOTNUM IS IT IN ERROR ALREADY?
BO OK YEP - LEAVE FLAGS ALONE
NI NUMFLGS,X'FF'-POS NO - RESET POSITIVE AND
OI NUMFLGS,NEG - - - -> SWITCH ON NEGATIVE
B OK RETURN TO TEST.
NUMTM TM 0(R9),X'0' ACTUAL NUMERIC TEST
SPACE 1
PUTIT L R9,MSGCNT SET MESSAGE LIMIT.
SR R3,R3 SET FOR
L R4,MSGADDR - - - -> MESSAGE MOVES
ICM R7,8,NUMFLGS PROCESS
MSGLOOP SLDL R6,1 - - - -> EACH FLAG
STC R6,LIVEFLG - - - - - - - -> IN TURN
TM LIVEFLG,ON IS FLAG SET ON?
BZ SKIPMSG NO - SKIP MESSAGE.
LH R3,0(R4) OBTAIN
EX R3,GETMSG - - - -> MESSAGE TEXT
PUT OUTDCB,RECORD ISSUE ASSOCIATED MESSAGE, AND
MVI RECORD,C' ' CLEAR THE
MVC RECORD+1(L'RECORD-1),RECORD - - - - -> OUTPUT AREA.
SKIPMSG AH R4,0(R4) INCREMEMT BY MSG TEXT +
LA R4,2(R4) - - - -> LENGTH FIELD
BCT R9,MSGLOOP REPORT ALL MESSAGES
BR R11 RETURN FROM WHENCE I CAME.
GETMSG MVC PMSG(0),2(R4) PRINT THE MESSAGE
SPACE 1
READDONE CLOSE (INDCB,,OUTDCB) CLOSE BOTH FILES
L R13,PRESAVE R13 = PREVIOUS SAVE AREA ADDR.
RETURN (14,12),RC=0 RESTORE REGISTERS
EJECT
LTORG
SPACE 1
MSGADDR DS F ADDR OF GOTTEN MESSAGES
MSGCNT DC AL4((MSGE-MSGS)*8) THE NUMBER OF MESSAGES.
MSGS DS 0C START OF MSG FLAGS.
NUMFLGS DC XL1'0' HOLDS FLAGS FROM VARIOUS TESTS
NOTNUM EQU 1 .... ...1 X'01' NOT NUMERIC
NEG EQU 2 .... ..1. X'02' NEGATIVE
POS EQU 4 .... .1.. X'04' POSITIVE
BYTE3 EQU 8 .... 1... X'08' 3RD BYTE DUFF
BYTE2 EQU 16 ...1 .... X'10' 2ND BYTE DUFF
BYTE1 EQU 32 ..1. .... X'20' 1ST BYTE DUFF
MSGE DS 0C END OF MESSAGE FLAGS
DEFAULTS DC XL1'4' SET DEFAULT FLAGS.
LIVEFLG DC AL1(*-*) FLAG TESTING BYTE
ON EQU 1 .... ...1 X'01' MEANS FLAG SET
INDCB DCB MACRF=GM,EODAD=READDONE,DDNAME=INDD,DSORG=PS
SPACE 1
OUTDCB DCB MACRF=PM,RECFM=F,LRECL=80,DSORG=PS,DDNAME=OUTDD
SPACE 1
RECORD DS 0CL80 OVERLAY FOR OUTPUT RECORD.
PNAME DC CL9' '
PAMOUNT DC CL3' ' INPUT FIELD
DC CL2' '
PMSG DC CL66' '
OUTRECE DS 0C END OF OUTPUT RECORD
SPACE 1
NUMOPTS DC AL1(240),AL1(224),AL1(208),AL1(192),AL1(176),AL1(160)
A EQU 160
B EQU 176
C EQU 192
D EQU 208
E EQU 224
F EQU 240
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
The data only message table module (EX9MSGS) follows.
PRINT NOGEN
TITLE 'EX9MSGS - MESSAGE DATA ONLY CSECT'
EX9MSGS CSECT
MSGAREA DS 0AL2,0C LENGTH + MESSAGE
MSG01 DC AL2(1),C' ' RESERVED MSG AREA
MSG02 DC AL2(1),C' ' RESERVED MSG AREA
MSG03 DC AL2(26),C'LEFTMOST BYTE IS IN ERROR.'
MSG04 DC AL2(23),C'MIDDLE BYTE IS IN ERROR'
MSG05 DC AL2(27),C'RIGHTMOST BYTE IS IN ERROR.'
MSG06 DC AL2(18),C'FIELD IS POSITIVE.'
MSG07 DC AL2(18),C'FIELD IS NEGATIVE.'
MSG08 DC AL2(21),C'FIELD IS NOT NUMERIC.'
END
Copyright © KMS-IT Limited 2002