*/ 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