ibm:vm370-lib:macro:xdict.macro_src
Table of Contents
XDICT Source
References
- Fixes Applied : 0
- This Source Date : Saturday, June 19, 2004
- Last Fix ID : [Unmodified]
Source Listing
- XDICT.MACRO.txt
- */ 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
ibm/vm370-lib/macro/xdict.macro_src.txt · Last modified: 2023/08/06 13:38 by Site Administrator