*/ ADD NAME=XDICT 8000-03343-03343-2118-00607-00607-00000-GREG
MACRO 00010000
&ID XDICT &DUMMY,&TESTRAN=NO,&DIAG=NO,&LEVEL=1 00020000
GBLC &COMPNM COMPONENT NAME 00030000
LCLC &NM MODULE NAME 00040000
JHEAD 'EXTERNAL SYMBOL DICTIONARY SUBROUTINES', ,00050000
PHASEID=&ID,LEVEL=&LEVEL 00060000
&NM SETC '&COMPNM&ID' 00070000
* * 00080000
*TITLE- EXTERNAL SYMBOL DICTIONARY ROUTINES * 00090000
* * 00100000
*FUNCTION/OPERATION- * 00110000
* BUILD AND MAINTAIN THE EXTERNAL SYMBOL DICTIONARY * 00120000
* PRINT AND PUNCH THE EXTERNAL SYMBOL DICTIONARY * 00130000
* BUILD THE EXTERNAL SYMBOL DICTIONARY ADJUSTMENT TABLE * 00140000
* * 00150000
*ENTRY POINT- * 00160000
ENTRY &NM.01 00170000
* * 00180000
*INPUT- * 00190000
* REGISTERS- * 00200000
* R4- REGISTER CONTAINING THE ADDRESS OF THE * 00210000
* RECORD BEING PROCESSED * 00220000
* R5- REGISTER CONTAINING THE ADDRESS OF THE * 00230000
* OPERAND BEING PROCESSED * 00240000
* R6- REGISTER CONTAINING THE ADDRESS OF THE * 00250000
* CURRENT CONTROL SECTION ESD ENTRY * 00260000
* * 00270000
*OUTPUT- * 00280000
* REGISTERS- * 00290000
* R10 REGISTER CONTAINING THE ADDRESS OF THE * 00300000
* NEW CURRENT CONTROL SECTION ESD ENTRY, IF * 00310000
* CHANGED * 00320000
* * 00330000
*EXITS, NORMAL- * 00340000
* EXITS TO THE CALLING ROUTINE * 00350000
* * 00360000
*EXITS, ERROR- * 00370000
* EXITS TO THE CALLING ROUTINE * 00380000
* * 00390000
*TABLES/WORK AREAS- * 00400000
* ESDBLK1- A BLOCK IN STORAGE TO CONTAIN A MAXMI * 00410000
* ESDBLK1- A BLOCK OF STORAGE TO CONTAIN A MAXIMUM OF 16 ESD * 00420000
* ENTRIES, ALSO SERVES AS AN INPUT/OUTPUT BUFFER * 00430000
* FOR THE OVERFLOW FILE (FILE2) WHEN NECESSARY * 00440000
* ESDBLK2- SAME FUNCTION AS ESDBLK1 ABOVE * 00450000
* NOTELIST- A LIST OF NOTE PARAMETERS OF OVERFLOWED ESD BLOCKS * 00460000
* WHEN NOT IN CORE * 00470000
* * 00480000
*ATTRIBUTES- * 00490000
* REFRESHABLE * 00500000
* * 00510000
*NOTES * 00520000
* * 00530000
EJECT 00540000
COPY JCOMMON 00550000
EJECT 00560000
COPY JTEXT 00570000
EJECT 00580000
COPY ICOMMON 00590000
EJECT 00600000
JTEXT DSECT , 00610000
ORG JTEXT 00620000
COPY RSYMRCD 00630000
EJECT 00640000
&NM.00 CSECT 00650000
* VS1 REL 2.6 CHANGES 00660000
*C221000 OX00106 00670000
*A246500,430500,481500 OX00106 00680000
*C430500,481500 @OY08064 00690000
JMODID 00700000
&NM.01 CONTENTS 00710000
USING &NM.01,R8 BASE REGISTER 00720000
EJECT 00730000
*TITLE- BLDESD * 00740000
* * 00750000
*FUNCTION/OPERATION- * 00760000
* BUILD OR RESUME AN ESD ENTRY * 00770000
* * 00780000
*INPUT- R4 CONTAINS A POINTER TO THE RECORD BEING PROCESSED * 00790000
* R10 CONTAINS A POINTER TO A PARAMETER LIST * 00800000
* * 00810000
*OUTPUT- R10 CONTAINS A POINTER TO THE ESD ENTRY * 00820000
* * 00830000
SPACE 00840000
BLDESD BALR R14,R7 SAVE REGISTERS IN STACK 00850000
LR R8,R12 SET UP BASE REGISTER 00860000
LA R2,D1 INCREMENT IN 00870000
LR R3,R2 TWO REGISTER 00880000
LR R5,R10 SAVE POINTER 00890000
AH R2,D0(,R5) ESDID 00900000
AH R3,HIESDNR ESD NUMBER 00910000
STH R2,XESDI ESDID 00920000
STH R3,XLNGQ ESD NUMBER 00930000
MVC XFLGB,XPARM FLAGS 00940000
SR R0,R0 ZERO 00950000
ST R0,XLCTR INITIAL VALUE 00960000
OC XESDI(D1),XPARM+D3 FLAG FOR DSECT OR COM 00970000
BLDESD1 MVC XTYPE,XPARM+D1 TYPE 00980000
MVC XNAME,=8AL1(JBLANK) PAD 00990000
MVC XNAME(D1),XTYPE NAME 01000000
GOIF RFIELDN,OFF=BLDESD2 SKIP IF NO NAME 01010000
MVC RLNGQ,=H'1' LENGTH ATTRIBUTE 01020000
GOIF PRIORDEF,ON=BLDESD2 SKIP IF PREVIOUSLY DEFINED 01030000
MVC XNAME,RNAME GET NAME 01040000
MVC XTYPE,XPARM+D2 TYPE 01050000
BLDESD2 LA R10,XWORK PASS RECORD POINTER 01060000
GOTO ENTER TRY TO ENTER IN SYMBOL TABLE 01070000
BNE BLDESD5 ALREADY IN SYMBOL TABLE 01080000
STH R2,D0(,R5) SAVE ESDID 01090000
STH R3,HIESDNR SAVE ESD NUMBER 01100000
TM XESDI,CSW2+DSW2 COM OR DSECT 01110000
BNE BLDESD4 SKIP IF SO 01120000
NC FSTCSECT,FSTCSECT SEE IF FIRST CSECT 01130000
BNE BLDESD3 SKIP IF NOT 01140000
STH R3,FSTCSECT FIRST CSECT ESD NUMBER 01150000
BLDESD3 CLI XTYPE,ETYPEPC PRIVATE CODE 01160000
BNE BLDESD4 SKIP IF NOT 01170000
STH R2,JESDID ESDID OF PRIVATE CODE 01180000
BLDESD4 LR R10,R3 ESD NUMBER 01190000
GOTO GETESD GET ESD ENTRY 01200000
LM R2,R3,XTYPE TYPE, ESDID, ADDRESS 01210000
SR R4,R4 INITIALIZE 01220000
LM R5,R6,XNAME NAME 01230000
STM R2,R6,ETYPE-ETYPE(R10) CREATE ESD ENTRY 01240000
B EXIT EXIT 01250000
BLDESD5 CLC SFLGS,XFLGB SEE IF SAME TYPE SECTION 01260000
BE BLDESD6 RESUME SECTION IF SAME 01270000
NI XPARM,BITFF-(XDUMMY) DISCOUNT EXTERNAL DUMMYS 01280000
CLC SFLGS,XPARM GIVE IT ANOTHER CHANCE 01290000
BE BLDESD6 LET THIS ONE GO 01300000
SET PRIORDEF,ON INDICATE PREVIOUSLY DEFINED 01310000
B BLDESD1 IGNORE NAME 01320000
BLDESD6 LH R10,SLNGQ ESD ASCENDSION NUMBER 01330000
GOTO GETESD RESUME ESD ENTRY 01340000
SET DEFINED,ON INDICATE RESUMED SECTION 01350000
B EXIT EXIT 01360000
EJECT 01370000
*TITLE- GETESD * 01380000
* * 01390000
*FUNCTION/OPERATION- * 01400000
* GET AN ESD ENTRY * 01410000
* * 01420000
*INPUT- R10 CONTAINS THE ESD NUMBER * 01430000
* * 01440000
*OUTPUT- R10 CONTAINS A POINTER TO THE ENTRY * 01450000
* * 01460000
SPACE 01470000
GETESD BALR R14,R7 SAVE REGISTER IN STACK 01480000
LR R8,R12 SET UP BASE REGISTER 01490000
LR R2,R10 INTO WORK REGISTER 01500000
LA R10,D16*D32 MAXIMUM ESD ENTRIES GP@P6 01510000
CR R10,R2 SEE IF EXCEEDED 01520000
BNL GETESD0 NOPE 01530000
BAL R9,GETESD RECURSIVE CALL 01540000
SET JESDOFLO,ON INDICATE ESD OVERFLOW 01550000
MVI D0(R10),D3 OVERFLOW ENTRY 01560000
XC D1(D19,R10),D1(R10) INITIALIZE 01570000
B EXIT RETURN 01580000
GETESD0 BCTR R2,D0 ESD NUMBER 01590000
SRDL R2,D4 BLOCK NUMBER 01600000
LR R4,R2 NOTE/POINT ADDRESS FOR BLOCK 01610000
MH R4,=H'9' X 01620000
LA R4,NOTELIST(R4) X 01630000
SRL R3,D28 DISPLACEMENT 01640000
MH R3,=H'20' DISPLACEMENT 01650000
TM D8(R4),BIT7 SEE IF THIS A NEW BLOCK 01660000
BO GETESD4 NO 01670000
TM FILELAST+D8,BIT7 SEE IF FLIE POSITIONED TO WRITE 01680000
BZ GETESD1 YES 01690000
JPOINT FILE=FILE2,ADDR=FILELAST,NEXT=WRITE POSITION FILE 01700000
GETESD1 LA R5,ESDBLK2 POINT TO SECOND BLOCK 01710000
CR R5,R6 SEE IF BLOCK CURRENTLY IN USE 01720000
BH GETESD2 NO 01730000
LA R5,ESDBLK1 POINT TO FIRST BLOCK 01740000
GETESD2 JWRITE FILE=FILE2,PARM=(R5) WRITE DESIGNATED BLOCK 01750000
MVI FILELAST+D8,D0 INDICATE FILE POSITIONED TO END 01760000
JCHECK FILE=FILE2 CHECK WRITE OPERATION 01770000
JNOTE FILE=FILE2 NOTE ADDRESS OF BLOCK ON FILE 01780000
LH R1,D6(,R5) BLOCK NUMBER OF BLOCK WRITTEN 01790000
MH R1,=H'9' NOTE/POINT ADDRESS FOR BLOCK 01800000
LA R1,NOTELIST(R1) X 01810000
MVI D8(R1),BIT6 INDICATE BLOCK ON FILE 01820000
MVC D0(D8,R1),JNOTEVAL SAVE BLOCK NOTE/POINT ADDRESS 01830000
MVC FILELAST(D8),JNOTEVAL NOTE/POINT ADDRESS OF FILE END 01840000
TM D8(R4),BIT6 SEE IF BLOCK ON FILE 01850000
BZ GETESD3 NOPE 01860000
JPOINT FILE=FILE2,ADDR=(R4),NEXT=READ POINT TO BLOCK 01870000
JREAD FILE=FILE2,PARM=(R5) BRING IN BLOCK 01880000
MVI FILELAST+D8,BIT7 INDICATE FILE NOT POSITIONED 01890000
JCHECK FILE=FILE2 CHECK READ OPERATION 01900000
GETESD3 ST R5,JFWORD1 ADDRESS OF BLOCK 01910000
MVI D8(R4),BIT7 INDICATE BLOCK IS IN CORE 01920000
MVC D0(D4,R4),JFWORD1 SAVE ADDRESS OF BLOCK IN CORE 01930000
GETESD4 MVC JFWORD1,D0(R4) ADDRESS TO FULLWORD BOUNDARY 01940000
L R5,JFWORD1 ADDRESS OF BLOCK IN CORE 01950000
STH R2,D6(,R5) BLOCK NUMBER 01960000
LA R10,D8(R3,R5) POINT TO ENTRY REQUESTED 01970000
B EXIT RETURN 01980000
EJECT 01990000
*TITLE- MAKESD * 02000000
* * 02010000
*FUNCTION/OPERATION- * 02020000
* CREATE THE ESD ADJUSTMENT TABLE * 02030000
* ESD FINISHING AND OUTPUT * 02040000
* * 02050000
*INPUT- THE EXTERNAL SYMBOL DICTIONARY (ESD). * 02060000
* * 02070000
*OUTPUT- THE ESD ADJUSTMENT TABLE. * 02080000
* THE EXTERNAL SYMBOL DICTIONARY ON THE SYSTEM OUTPUT FILES. * 02090000
* * 02100000
SPACE 02110000
ENTRY BALR R14,R7 SAVE REGISTERS IN STACK 02120000
LR R8,R12 SET UP BASE REGISTER 02130000
LR R10,R4 PASS RECORD POINTER 02140000
MVI RFLGB,ESDNRSW+ENTRYSW SET FLAGS 02150000
GOTO FIND LOOKUP IN SYMBOL TABLE 02160000
BZ ENTRY2 ERROR 02170000
GOIF (MODE1,MODE2),ANY=EXIT SUSPEND ACTION IF NOT MODE IA 02180000
GOTO ENTER ENTER IN SYMBOL TABLE 02190000
LH R10,HIESDNR GET HIGHEST ESD NUMBER 02200000
LA R10,D1(,R10) GET NEXT ESD NUMBER 02210000
STH R10,HIESDNR SAVE 02220000
STH R10,SLNGQ ESD ASCENDSION NUMBER 02230000
GOTO GETESD FIND ROOM IN ESD 02240000
MVI ETYPE-EITEM(R10),ETYPELX PRIME ESD ENTRY 02250000
ENTRY1 MVI RTYPE,JTSYMBL CHECK BACK IN PASS 2 02260000
B EXIT FINIS 02270000
ENTRY2 GOIF (ESDNRSW,XENTRY,CSECTSW,DSECTSW),ALL=ENTRY1,MIX=ENTRY3 02280000
GOIF (CSW,DSW,ESW),ANY=ENTRY3 INVALID OX00106 02290000
SR R0,R0 SEE IF 02300000
CH R0,SESDI ABSOLUTE 02310000
BZ ENTRY3 BAD 02320000
SET XENTRY,ON INDICATE VALID ENTRY 02330000
OI RFLGB,XENTRY INDICATE VALID ENTRY 02340000
MVC RESDI(D6),SESDI ESDID AND ADDRESS 02350000
LH R10,HIESDNR GET HIGHERS ESD NUMBER 02360000
LA R10,D1(,R10) GET NEXT ESD NUMBER 02370000
STH R10,HIESDNR SAVE 02380000
GOTO GETESD GET ESD ENTRY 02390000
MVI ETYPE-EITEM(R10),ETYPELD ESD ENTRY TYPE 02400000
MVC EESDI-EITEM(D6,R10),RESDI ESDID AND VALUE 02410000
MVC ENAME-EITEM(D8,R10),RNAME NAME 02420000
MVI RTYPE,JTADJII ADJUST VALUE IN IIA 02430000
B EXIT FINIS 02440000
ENTRY3 MVI RTYPE,JTPASS INVALID ENTRY 02450000
B EXIT FINIS 02460000
EXTRN BALR R14,R7 SAVE REGISTERS IN STACK 02470000
LR R8,R12 SET UP BASE REGISTER 02480000
LA R2,D1 INCREMENT 02490000
LR R3,R2 IN TWO REGISTERS 02500000
STH R2,RLNGQ LENGTH ATTRIBUTE OF SYMBOL 02510000
AH R2,HICESDID NEXT ESDID 02520000
AH R3,HIESDNR NEXT ESD NUMBER 02530000
EXTRN1 STH R2,RESDI ESDID 02540000
SET ESW1,ON SET EXTRN/EQU FLAG OX00106 02550000
EXTRN2 XI RNAME,BIT0 UNIQUE NAME 02560000
LR R10,R4 PASS RECORD POINTER 02570000
GOTO ENTER ENTER INTO SYMBOL TABLE 02580000
BNE EXTRN5 ALREADY IN SYMBOL TABLE 02590000
TM RNAME,BIT0 SEE IF FIRST TIME AROUND 02600000
BNE EXTRN2 ENTER SECOND TIME IF FIRST 02610000
CH R3,HIESDNR SEE IF NEW ENTRY 02620000
BNH EXTRN3 SKIP IF NOT NEW 02630000
STH R2,HICESDID SAVE NEW ESDID 02640000
STH R3,HIESDNR SAVE NEW0ESD NUMBER 02650000
EXTRN3 LR R10,R3 PASS ESD NUMBER 02660000
GOTO GETESD GET ESD ENTRY 02670000
MVC ETYPE-EITEM(D8,R10),RTYPE 02680000
MVC ENAME-EITEM(D8,R10),RNAME 02690000
EXTRN4 MVI RTYPE,JTPASS NO PROCESS RECORD IN PASS 2 02700000
B EXIT 02710000
EXTRN5 LH R2,SESDI GET ESDID OF PREVIOUS ENTRY 02720000
LH R3,SLNGQ GET ESD ASCENDSION NUMBER 02730000
TM RNAME,BIT0 SEE IF FIRST TIME AROUND 02740000
BNE EXTRN1 GO AGAIN IF FIRST 02750000
SET PRIORDEF,ON INDICATE PREVIOUSLY DEFINED 02760000
B EXTRN4 EXIT 02770000
VCON BALR R14,R7 SAVE REGISTERS IN STACK 02780000
LR R8,R12 SET UP BASE REGISTER 02790000
LR R3,R2 IN TWO REGISTERS 02800000
AH R2,HICESDID GET NEXT ESDID 02810000
AH R3,HIESDNR GET NEXT ESD NUMBER 02820000
STH R2,XESDI ESDID 02830000
STH R3,XLNGQ ESD NUMBER 02840000
MVI XTYPE,ETYPEER TYPE 02850000
MVI XFLGB,ESDNRSW FLAGS 02860000
OI XNAME,BIT0 EXTERNAL NAME 02870000
SR R0,R0 ZERO 02880000
STH R0,XLCTR VALUE 02890000
LA R10,XWORK POINTER TO ENTRY 02900000
GOTO ENTER ENTER IN SYMBOL TABLE 02910000
BNZ EXIT ALREADY IN SYMBOL TABLE 02920000
STH R2,HICESDID SAVE ESDID 02930000
STH R3,HIESDNR SAVE ESD NUMBER 02940000
XI XNAME,BIT0 RESET 02950000
LR R10,R3 GET ESD NUMBER 02960000
GOTO GETESD GET ESD ENTRY 02970000
MVC ETYPE-EITEM(D8,R10),XTYPE TYPE, FLAGS, ESDID, VALUE 02980000
MVC ENAME-EITEM(D8,R10),XNAME NAME 02990000
B EXIT RETURN 03000000
QCON BALR R14,R7 SAVE REGISTERS IN STACK 03010000
LR R8,R12 SET UP BASE REGISTER 03020000
LA R10,XWORK PASS POINTER TO WORK AREA 03030000
GOTO FIND LOOKUP IN SYMBOL TABLE 03040000
BNE EXIT NOT IN SYMBOL TABLE 03050000
GOIF (ESDNRSW,DSECTSW,DSCOMSW,XDUMMY),NOTALL=EXIT VALID NAME 03060000
SET XDUMMY,OFF ONE TIME ONLY PER DSECT NAME 03070000
LR R10,R2 INCREMENT IN TWO REGISTERS 03080000
AH R2,HICESDID NEXT ESDID 03090000
STH R2,HICESDID SAVE ESDID 03100000
LH R3,SLNGQ ESD ASCENDSION NUMBER 03110000
AH R10,HIESDNR NEXT ESD NUMBER 03120000
STH R10,HIESDNR SAVE ESD NUMBER 03130000
GOTO GETESD GET ESD ENTRY 03140000
MVC ENAME-EITEM(D8,R10),XNAME NAME 03150000
STH R2,EESDI-EITEM(,R10) ESDID 03160000
OI ESWTS-EITEM(R10),QDSW2 INDICATE XD ENTRY 03170000
STH R3,EHILC-EITEM(,R10) ESD ASCENDSION NUMBER 03180000
MVI ETYPE-EITEM(R10),ETYPEDX TYPE 03190000
B EXIT EXIT 03200000
SUMESD BALR R14,R7 PUSH DOWN ONE MORE LEVEL 03210000
SUMGET LR R10,R4 PASS 03220000
BAL R2,GOTESD GET ESD ITEM 03230000
SR R2,R2 ZERO FUNCTION BYTE REGISTER 03240000
TRT ETYPE,SUMTBL GET ROUTINE ADDRESS 03250000
B SUMGET(R2) GO TO ROUTINE 03260000
SUMCST LM R14,R15,ELCTR GET CURRENT AND HIGH ADDRESS 03270000
CR R14,R15 SEE IF CURRENT IS ALSO HIGH 03280000
BNH SUMCST1 SKIP IF NOT 03290000
LR R15,R14 SAVE HIGH 03300000
SUMCST1 SR R14,R14 ASSUME NO OFFSET 03310000
GOIF (CSW2,DSW2),ANY=SUMCST3 NO OFFSET FOR DSECTS OR COMS 03320000
L R14,STARTLOC GET START ADDRESS 03330000
NR R14,R5 ROUND TO SECTION ALIGNMENT 03340000
LA R0,D7 INCREMENT 03350000
AR R0,R14 COMPUTE NEXT START ADDRESS 03360000
AR R0,R15 COMPUTE NEXT START ADDRESS 03370000
ST R0,STARTLOC SAVE 03380000
LTR R14,R14 SEE IF ADJUSTMENT REQUIRED 03390000
BZ SUMCST3 NOPE 03400000
ST R14,D4(,R4) ADJUSTMENT FACTOR 03410000
MVC D0(D2,R4),EESDI ARGUMENT ESDID 03420000
SUMCST2 MVC D2(D2,R4),EESDI TARGET ESDID 03430000
SR R4,R5 POINT TO NEXT ADJUSTMENT ENTRY 03440000
SUMCST3 STM R14,R15,ELCTR ADDRESS AND LENGTH 03450000
B SUMGET CONTINUE WITH NEXT ENTRY 03460000
SUMDXD LM R15,R0,ELCTR GET LENGTH AND ALIGNMENT FACTOR 03470000
LR R14,R0 REORDER 03480000
B SUMCST3 SKIP 03490000
SUMDSD MVI ETYPE,ETYPEXD CHANGE TYPE 03500000
LH R10,EHILC GET ESD ASCENDSION NUMBER 03510000
GOTO GETESD GET ESD ENTRY 03520000
LA R14,D7 ALIGNMENT FACTOR 03530000
L R15,EHILC-EITEM(,R10) LENGTH 03540000
XC D4(D4,R4),D4(R4) 03550000
MVC D0(D2,R4),EESDI-EITEM(R10) 03560000
B SUMCST2 03570000
GOTESD LA R3,D1(,R3) GET NEXT ESD NUMBER 03580000
CH R3,HIESDNR SEE IF ALL THROUGH 03590000
BH EXIT FINIS 03600000
LR R10,R3 PASS ESD NUMBER 03610000
GOTO GETESD GET ESD ENTRY 03620000
LR R6,R10 RETURN POINTER 03630000
BR R2 RETURN 03640000
MAKESD BALR R14,R7 SAVE REGISTERS IN STACK 03650000
LR R8,R12 SET UP BASE REGISTER 03660000
L R4,LATEND ESD ADJUSTMENT TABLE POINTER 03670000
LH R5,=H'-8' INCREMENT 03680000
MVI CARDADDR+D3,48 FLUSH CARD PUNCH BUFFER 03690000
SR R3,R3 ESD NUMBER INITIALIZED 03700000
BAL R9,SUMESD SUM CONTROL SECTIONS 03710000
S R10,LATEND LENGTH OF ESD ADJUSTMENT TABLE 03720000
LR R11,R5 INCREMENT 03730000
STM R10,R11,ADJINDEX SAVE FOR PASS TWO 03740000
MAKGET BAL R2,GOTESD GET NEXT SEQUENTIAL ESD ENTRY 03750000
SR R2,R2 ZERO FUNCTION BYTE REGISTER 03760000
LR R10,R2 CLEAR REGISTER 03770000
TRT ETYPE,MAKTBL GET ROUTINE ADDRESS 03780000
B MAKGET(R2) GO TO ROUTINE 03790000
MAKCST SET (QDSW2,DSW2,CSW2),OFF RESET XD DSECT OR COM BITS 03800000
CLI ENAME,J9 SEE IF NAMED 03810000
BH PRTESD SKIP IF NAMED 03820000
MAKPVT MVI ENAME,JBLANK FAKE THE BLANK 03830000
B PRTESD PRINT ESD ITEM 03840000
MAKTRY LM R14,R1,ADJINDEX ESD ADJUSTMENT INDEX 03850000
LH R10,EESDI GET ESDID 03860000
MAKTRY1 BXLE R14,R15,PRTESD SEE IF ADJUSTMENT REQUIRED 03870000
CH R10,D0(R1,R14) SEE IF THIS IS THE ENTRY 03880000
BNE MAKTRY1 NO, KEEP LOOKING 03890000
L R10,D4(R1,R14) GET ADJUSTMENT FACTOR 03900000
A R10,ELCTR ADD OFFSET 03910000
MAKEXT ST R10,ELCTR SAVE 03920000
EJECT 03930000
*TITLE- PRTESD * 03940000
* * 03950000
*FUNCTION/OPERATION- * 03960000
* PRINT AN ITEM IN THE EXTERNAL SYMBOL DICTIONARY * 03970000
* * 03980000
*INPUT- REGISTER R10 IS A POINTER TO AN ESD ENTRY * 03990000
* * 04000000
*OUTPUT- THE EXTERNAL SYMBOL DICTIONARY * 04010000
* * 04020000
SPACE 04030000
PRTESD EQU * 04040000
GOIF (JESD,JLIST),NOTALL=PCHESD SKIP IF NOT OPTIONED 04050000
LH R5,LINECNT GET LINE COUNT 04060000
GOIF (R5),POS=PRTESD2 SKIP IF NOT END OF PAGE 04070000
JPRINT GET PRINT BUFFER 04080000
SET EJECT CARRIAGE CONTROL FOR TITLE LINE 04090000
MVC DECKID,JDECKID DECK IDENTIFIER 04100000
MVC TITLE,ZTITLE SET TITLE 04110000
MVC PAGE,ZPAGEZ SET PAGE NUMBER DESIGNATOR 04120000
LH R14,JPAGENO GET OLD PAGE NUMBER 04130000
LA R14,1(,R14) INCREMENT BY 1 04140000
STH R14,JPAGENO SAVE PAGE NUMBER 04150000
CVD R14,JDWORD CONVERT PAGE NUMBER TO DECIMAL 04160000
UNPK PAGENO,JDWORD+6(2) UNPACK TO EBCDIC CODE 04170000
NC PAGENO,DIGMASK CONVERT TO INTERNAL CHARACTERS 04180000
GOIF PAGENO,J0,NOTEQ=PRTESD1 SKIP IF NOT A LEADING ZERO 04190000
MVI PAGENO,JBLANK FORCE TO A BLANK 04200000
GOIF PAGENO+1,J0,NOTEQ=PRTESD1 SKIP IF NOT A LEADING ZERO 04210000
MVI PAGENO+1,JBLANK FORCE TO A BLANK 04220000
PRTESD1 JPRINT GET PRINT BUFFER 04230000
MVC HEADING,ZHEADING SET SUBTITLE 04240000
MVC LVTMDT,JLVTMDT SET ASSEMBLER LEVEL, TIME, DATE 04250000
LH R5,JLNCT GET MAXIMUM LINE COUNT 04260000
PRTESD2 JPRINT GET PRINT BUFFER 04270000
SET SPACE1 CARRIAGE CONTROL FOR LINE 04280000
CH R5,JLNCT COMPARE TO MAXIMUM LINE COUNT 04290000
BL PRTESD3 SKIP IF NOT REACHED 04300000
SET SPACE2 CARRIAGE CONTROL FOR FIRST LINE 04310000
PRTESD3 BCTR R5,0 DECREMENT LINE COUNT 04320000
STH R5,LINECNT SAVE LINE COUNT 04330000
MVC ZSYMBOL,ENAME SET NAME 04340000
TRT ETYPE,ZTYPESZ TRANSLATE FIRST CHARACTER 04350000
STC R2,ZTYPE TO OUTPUT ITEM 04360000
TRT ETYPE,ZTYPESZ+D7 TRANSLATE SECOND CHARACTER 04370000
STC R2,ZTYPE+D1 TO OUTPUT ITEM 04380000
UNPK ZID(L'ZID+1),EESDI(L'EESDI+1) UNPACK WITH ROOM TO SPARE 04390000
NC ZID,DIGMASK CONVERT TO INTERNAL CHARACTERS 04400000
MVI ZID+L'ZID,JBLANK REPAIR DAMAGE 04410000
NI ZID+1,BITFF-ESW-EQUF @OY08064 04420000
GOIF ETYPEER,EQUAL=PCHESD FINIS FOR EXTERNAL REFERENCE 04430000
GOIF ETYPEWX,EQUAL=PCHESD FINIS FOR EXTERNAL REFERENCE 04440000
UNPK ZADDR(L'ZADDR+1),ELCTR(L'ELCTR+1) UNPACK WITH EXCESS 04450000
NC ZADDR,DIGMASK CONVERT TO INTERNAL CHARACTERS 04460000
MVI ZADDR+L'ZADDR,JBLANK REPAIR DAMAGE 04470000
GOIF ETYPELD,NOTEQ=PRTESD4 SKIP IF NOT LD TYPE 04480000
MVC ZLDID,ZID PUT IN PROPER PERSPECTIVE 04490000
MVC ZID,ZID-1 REPAIR 04500000
B PCHESD FINISHED IF LD TYPE 04510000
PRTESD4 UNPK ZLENGTH(L'ZLENGTH+1),EHILC(L'EHILC+1) UNPACK 04520000
NC ZLENGTH,DIGMASK CONVERT TO INTERNAL CHARACTERS 04530000
MVI ZLENGTH+L'ZLENGTH,JBLANK REPAIR 04540000
EJECT 04550000
*TITLE- PCHESD * 04560000
* * 04570000
*FUNCTION/OPERATION- * 04580000
* PUNCH ONE ITEM IN THE EXTERNAL SYMBOL DICTIONARY. * 04590000
* * 04600000
*INPUT- REGISTER R6 IS A POINTER TO ONE ITEM IN THE EXTERNAL SYMBOL * 04610000
* DICTIONARY. * 04620000
* * 04630000
*OUTPUT- THE EXTERNAL SYMBOL DICTIONARY ON THE PUNCH AND LINK FILES. * 04640000
* * 04650000
SPACE 04660000
PCHESD GOIF (JDECK,JLINK),NONE=MAKGET RETURN IF NOT OPTIONED 04670000
LM R10,R11,CARDADDR GET ADDRESS OF CARD 04680000
CLI CARDADDR+D3,48 SEE IF ANOTHER CARD NEEDED 04690000
BL PCHESD1 NOT NECESSARILY 04700000
JPUNCH SEQ=YES GET ANOTHER CARD BUFFER 04710000
SET JENDCHK,ON PUNCH END CARD WHEN TIME COMES 04720000
MVC CARDID,ZESDZ CARD IDENTIFIER 04730000
TR CARDID+D1(71),JTRTABLE TRANSLATE TO EXTERNAL CODE 04740000
MVI DATALN,D0 HIGH ORDER BYTE OF FIELD ZEROED 04750000
SR R10,R10 NEW CARD BUFFER INDICATION 04760000
PCHESD1 LA R10,NEXTITEM POINT TO NEXT ENTRY SPACE 04770000
STM R10,R11,CARDADDR SAVE ADDRESS OF CARD 04780000
STC R10,DATALN+1 LENGTH OF DATA 04790000
ALR R10,R11 POINTER TO ESD DATA ITEM IN R3 04800000
MVC ZZSYMBOL,ENAME SET NAME 04810000
TR ZZSYMBOL,JTRTABLE CONVERT TO EXTERNAL CHARACTERS 04820000
MVC ZZTYPE,ETYPE SET TYPE 04830000
MVC ZZADDR,ELCTR+L'ELCTR-L'ZZADDR SET ADDRESS 04840000
GOIF ETYPEXD,NOTEQ=PCHESD3 SKIP IF NOT XD TYPE 04850000
MVC ZZADDR(L'ZZADDR+L'ZZALGN),ELCTR SET ALIGNMENT FACTOR 04860000
PCHESD3 GOIF ETYPELD,NOTEQ=PCHESD4 SKIP IF NOT LD TYPE 04870000
MVC ZZLENGTH+L'ZZLENGTH-L'EESDI(L'EESDI),EESDI LDID 04880000
MVI ZZLENGTH,X'00' PAD WITH LEADING ZEROS 04890000
B MAKGET FINIS 04900000
PCHESD4 TM FIRSTID,X'F0' SEE IF ESDID SET 04910000
BZ PCHESD5 SKIP IF ALREADY SET 04920000
MVC FIRSTID,EESDI SET ESDID OF FIRST NON LD ITEM 04930000
NI FIRSTID,BITFF-BIT4-EQUF @OY08064 04940000
PCHESD5 GOIF ETYPEER,EQUAL=MAKGET FINIS FOR EXTERNAL REFERENCE 04950000
GOIF ETYPEWX,EQUAL=MAKGET FINIS FOR EXTERNAL REFERENCE 04960000
MVC ZZLENGTH,EHILC+L'EHILC-L'ZZLENGTH SET LENGTH 04970000
B MAKGET FINIS 04980000
EJECT 04990000
REFER BALR R14,R7 SAVE REGISTERS IN STACK 05000000
LR R8,R12 SET UP BASE REGISTER 05010000
MVC XWORK(D12),=AL1(0,24,JPSOP,0,JTSYMBL,0,0,0,0,0,0,0) 05020000
LA R10,XWORK SYMBOL POINTER 05030000
GOTO FIND LOOK UP IN SYMBOL TABLE 05040000
BZ REFER2 FIND IN SYMBOL TABLE 05050000
REFER1 GOIF MODE2,ON=EXIT DUMPING LITERALS ON OVERFLOW 05060000
B REFER4 UNDEFINED AS YET 05070000
REFER2 GOIF ENTRYSW,ON=REFER1 NOT A DEFINED SYMBOL 05080000
MVC XTYPE(D2),=AL1(JTADJII,DEFINED+PRIORDEF) 05090000
GOIF MODE2,OFF=REFER3 SKIP IF NOT OVERFLOW 05100000
MVI XTYPE,JTSYMII REHASH IN PASS TWO 05110000
REFER3 MVC XFLGB,SFLGS SYMBOL FLAGS 05120000
MVC XESDI(D6),SESDI ESDID AND VALUE 05130000
LH R15,SLNGQ LENGTH ATTRIBUTE 05140000
GOIF ESDNRSW,OFF=REFER5 EXTERNAL SYMBOL 05150000
REFER4 LA R15,D1 LENGTH ATTRIBUTE 05160000
REFER5 STH R15,XLNGQ SET LENGTH ATTRIBUTE 05170000
LR R11,R10 05180000
LH R10,JOUTFILE OUTPUT FILE ADDRESS 05190000
JPUTM FILE=(R10),ADDR=(R11) 05200000
B EXIT FINIS 05210000
EJECT 05220000
* CONSTANTS * 05230000
SPACE 05240000
OIINST OI D0(R15),D0 EXECUTED INSTRUCTION 05250000
DIGMASK JGENIN 'FFFFFF' DIGIT MASK 05260000
ZTYPESZ JGENIN 'SLEXPCXDDRWCMDXXXX' TYPES 05270000
SUMTBL DC AL1(SUMCST-SUMGET) 00 - (SD) CONTROL SECTION 05280000
DC AL1(SUMGET-SUMGET) 01 - (LD) LABEL DEFINITION 05290000
DC AL1(SUMGET-SUMGET) 02 - (ER) EXTERNAL REFERENCE 05300000
DC AL1(SUMGET-SUMGET) 03 OVERFLOW ENTRY 05310000
DC AL1(SUMCST-SUMGET) 04 - (PC) PRIVATE CODE 05320000
DC AL1(SUMCST-SUMGET) 05 - (CM) COMMON 05330000
DC AL1(SUMDXD-SUMGET) 06 - (XD) EXTERNAL DUMMY 05340000
DC AL1(SUMDSD-SUMGET) 07 - EXTERNAL DUMMY 05350000
DC AL1(SUMCST-SUMGET) 08 - DUMMY CONTROL SECTION 05360000
DC AL1(SUMGET-SUMGET) 09 UNDEFINED ENTRY 05370000
DC AL1(SUMGET-SUMGET) 0A - (WX) EXTERNAL REFERENCE 05380000
MAKTBL DC AL1(PRTESD-MAKGET) 00 - (SD) CONTROL SECTION 05390000
DC AL1(MAKTRY-MAKGET) 01 - (LD) LABEL DIFINITION 05400000
DC AL1(MAKEXT-MAKGET) 02 - (ER) EXTERNAL REFERENCE 05410000
DC AL1(MAKGET-MAKGET) 03 OVERFLOW ENTRY 05420000
DC AL1(MAKPVT-MAKGET) 04 - (PC) PRIVATE CODE 05430000
DC AL1(MAKCST-MAKGET) 05 - (CM) COMMON 05440000
DC AL1(MAKCST-MAKGET) 06 - (XD) EXTERNAL DUMMY 05450000
DC AL1(MAKGET-MAKGET) 07 - NOT USED 05460000
DC AL1(MAKGET-MAKGET) 08 - DSECT 05470000
DC AL1(MAKGET-MAKGET) 09 - UNDEFINED ENTRY 05480000
DC AL1(MAKEXT-MAKGET) 0A - (WX) EXTERNAL REFERENCE 05490000
ZESDZ DC B'00000010' 12-9-2 CARD IDENTIFIER 05500000
JGENIN 'ESD' ESD CARD IDENTIFIER 05510000
ZPAGEZ JGENIN 'PAGE' PAGE NUMBER DESIGNATOR 05520000
ZTITLE JGENIN 'EXTERNAL SYMBOL DICTIONARY' ESD TITLE 05530000
ZHEADING DC YL1(SPACE3) CARRIAGE CONTROL CHARACTER 05540000
JGENIN 'SYMBOL TYPE ID ADDR LENGTH LDID' SUBTITLE 05550000
EJECT 05560000
DSECT10 DSECT , 05570000
ORG DSECT10 05580000
SPACE 05590000
ZZSYMBOL DS C'XXXXXXXX' NAME, BLANK FOR PC OR BLANK CM 05600000
ZZTYPE DS C'X' TYPE 05610000
ZZADDR DS C'XXX' ADDRESS 05620000
ZZALGN DS C'X' ALIGNMENT FACTOR FOR SC TYPE 05630000
ZZLENGTH DS C'XXX' LENGTH 05640000
NEXTITEM EQU * NEXT ITEM FOLLOWS IMMEDIATELY 05650000
SPACE 05660000
SPACE 05670000
DSECT11 DSECT , 05680000
ORG DSECT11 05690000
SPACE 05700000
CARD DS 0CL72 05710000
CARDID DS C' ESD' CARD IDENTIFIER 05720000
DS C' ' BLANK 05730000
DATALN DS H NUMBER OF BYTES OF ESD DATA 05740000
DS C' ' BLANK 05750000
FIRSTID DS H ESDID OF FIRST NON LD TYPE ITEM 05760000
DATAITEM DS CL16 05770000
SPACE 05780000
SPACE 05790000
ORG DSECT11 05800000
SPACE 05810000
LINE DS 0CL121 05820000
CTLCHAR DBV EJECT(0),SPACE1(1),SPACE2(2),SPACE3(3) CARRIAGE CONTROL 05830000
DECKID DS CL8 DECK IDENTIFIER 05840000
ORG LINE+48 05850000
TITLE DS C'EXTERNAL SYMBOL DICTIONARY' ESD TITLE 05860000
ORG LINE+112 05870000
PAGE DS C'PAGE' PAGE NUMBER DESIGNATOR 05880000
ORG LINE+118 05890000
PAGENO DS C'000' PAGE NUMBER 05900000
ORG LINE 05910000
HEADING DS C'3SYMBOL TYPE ID ADDR LENGTH LDID' 05920000
ORG LINE+L'LINE-L'JLVTMDT 05930000
LVTMDT DS CL(L'JLVTMDT) ASSEMBLER LEVEL, TIME, DATE 05940000
ORG LINE+1 05950000
ZSYMBOL DS C'XXXXXXXX' NAME, BLANK FOR PC OR BLANK CM 05960000
DS C' ' SPACES 05970000
ZTYPE DS C'XX' ESD ITEM TYPE 05980000
DS C' ' SPACES 05990000
ZID DS C'XXXX' ESD IDENTIFIER, IF NON LD TYPE 06000000
DS C' ' SPACE 06010000
ZADDR DS C'XXXXXX' ADDRESS, IF TYPE SD, PC, LD 06020000
DS C' ' SPACE 06030000
ZLENGTH DS C'XXXXXX' LENGTH, IF TYPE SD, PC, CM, SC 06040000
DS C' ' SPACE 06050000
ZLDID DS C'XXXX' ESD IDENTIFIER OF SD ENTRY 06060000
MEND 06070000
* ENDUP "REVIEW" PDS MEMBER OFFLOAD AT 21:58 ON 04/01/09