./ ADD SSI=00010927,NAME=IEWLDIDY,SOURCE=0 IDEN TITLE 'IDENTIFICATION MODULE FOR THE OS/360 LOADER' 07600000 *********************************************************************** 07800000 * * 08100000 *TITLE 'IEWLIDEN'- IDENTIFICATION MODULE FOR THE OS/360 LOADER * 08400000 * * 08700000 *STATUS -CHANGE LEVEL 0 * 09000000 * * 09300000 *FUNCTION/OPERATION - THIS MODULE PERFORMS THE FOLLOWING - * 09600000 * 1. BUILDS MINI-CESD OF SD'S AND CM'S FOLLOWING PROGRAM IF TSO * 09900000 * FLAG IS ON AND SPACE IS AVAILABLE. * 10200000 * 2. BUILDS EXTENT LIST FOR IDENTIFY MACRO. FIRST EXTENT DEFINES * 10500000 * LOADER-LOADED TEXT. SECOND EXTENT DEFINES MINI-CESD. REMAINING * 10800000 * EXTENTS DEFINE COMPILER.LOADED TEXT AS DESCRIBED ON MOD * 11100000 * RECORDS. * 11400000 * 3. ISSUES IDENTIFY MACRO * 11700000 * * 12000000 *ENTRY POINTS - IEWLIDEN * 12300000 * * 12600000 *INPUT - REGISTER 13 - ADDR OF SAVE AREA * 12900000 * REGISTER 14 - RETURN ADDRESS * 13200000 * REGISTER 11 - ADDR OF COMMUNICATIONS AREA * 13500000 * * 13800000 *OUTPUT - MINI-CESD MAY BE BUILT * 14100000 * PROGRAM WILL BE IDENTIFIED * 14400000 * * 14700000 *EXTERNAL ROUTINES - * 15000000 * * 15300000 * 'IEWERROR' - LOG ERROR MESSAGES * 15600000 * * 15900000 *EXITS - NORMAL- TO CALLER * 16200000 * ERROR - TO IEWERROR * 16500000 * * 16800000 *TABLES/WORK AREAS- * 17100000 * 'IEWLDCOM' - ALL COMMUNICATION INFORMATION * 17400000 * 'IDPARM' - PARAMETER LIST FOR IDENTIFY ROUTINE * 17700000 * 'MINICESD' - UNORDERED THREE WORD ENTRIES OF FORMAT * 18000000 * 0 4 8 9 * 18300000 * ***************** * 18600000 * * * *S* * WHERE BYTE 8 WILL BE 00 FOR SD * 18900000 * *CSECTNAME*D*ADR* 05 FOR CM * 19200000 * ***************** * 19500000 * * 19800000 *ATTRIBUTES - REFRESHABLE,REENTRANT,REUSABLE * 20100000 * * 20400000 *NOTES - NONE * 20700000 * * 21000000 *********************************************************************** 21300000 EJECT 21600000 IEWLIDEN CSECT 21900000 R0 EQU 0 WORK REGISTER 22200000 R1 EQU 1 WORK REGISTER 22500000 R2 EQU 2 WORK REGISTER 22800000 R3 EQU 3 WORK REGISTER 23100000 R4 EQU 4 WORK REGISTER 23400000 R5 EQU 5 WORK REGISTER 23700000 R6 EQU 6 WORK REGISTER 24000000 R7 EQU 7 IDENTIFY PARAMETER DSECT 24300000 * CAUTION - REGISTER 7 CHANGES AS EXTENT LIST CREATED 24400000 R8 EQU 8 WORK REGISTER 24600000 R9 EQU 9 WORK REGISTER 24900000 R10 EQU 10 WORK REGISTER 25200000 R11 EQU 11 COMMUNICATIONS AREA 25500000 R12 EQU 12 BASE REGISTER 25800000 R13 EQU 13 SAVE AREA REGISTER 26100000 R14 EQU 14 LINKAGE REGISTER 26400000 R15 EQU 15 LINKAGE REGISTER 26700000 * 27000000 * HOUSEKEEPING 27300000 * 27600000 USING *,R15 27900000 SAVE (14,12),,* 28200000 LR R12,R15 28500000 DROP R15 28800000 USING IEWLIDEN,R12 BASE REGISTER 29100000 USING IEWLDCOM,R11 COMMUNICATIONS AREA 29400000 USING ERCODES,0 ERROR CODE DSECT 29700000 L R13,8(R13) SAVE AREA CHAIN 30000000 * 30300000 * GET SPACE FOR IDENTIFY PARAMETER LIST 30600000 * 30900000 LH R8,CMNUMXS PICK UP NO. EXTENTS ON MOD CARDS 31200000 LTR R8,R8 WERE THERE ANY 31500000 BNZ ID5 YES. BRANCH 31800000 TM CMFLAG3,CQTS NO. HOW ABOUT MINICESD 32100000 BZ ID6 NO. DON'T WANT IT. BRANCH 32400000 ID5 LA R8,1(R8) EXTENT FOR MINI-CESD 32700000 ID6 LA R8,1(R8) EXTENT FOR LOADER LOADED TEXT 33000000 STH R8,CMNUMXS SAVE NO. OF EXTENTS 33300000 SLL R8,3 2 WORDS PER EXTENT PLUS 33600000 LA R8,20(R8) FIXED PORTION OF IDENTIFY PAEAMETER 33900000 * LIST GIVES TOTAL SPACE NEEDED 34200000 L R7,CMLOWTBL GET LOWEST TABLE ADDRESS 34500000 SR R7,R8 WILL THE PARM LIST FIT 34800000 TM CMFLAG4,CQCOMMON WAS COMMON ALLOC 35100000 BNO ID7 NO. BRANCH 35400000 C R7,CMTOPCOD YES. WE CAN OVLAP COMMON 35700000 BNL ID8 36000000 B IDTOOBIG CAN'T OVERLAY TEXT 36300000 ID7 C R7,CMNXTTXT SEE IF THERE'S ROOM 36600000 BL IDTOOBIG NO. BRANCH 36900000 ID8 ST R7,CMLOWTBL STORE NEW LOWEST TABLE ADDRESS 37200000 * 37500000 * MOVE IN ENTRY POINT AND PROGRAM NAME 37800000 * 38100000 USING IDPARM,R7 38400000 MVC IDEP(4),CMEPADDR MOVE ENTRY POINT 38700000 MVC IDNAM(8),CMPGMNM MOVE PROGRAM NAME 39000000 * 39300000 * INITIALIZE EXTENT LIST 39600000 * 39900000 LH R9,CMNUMXS STORE NO OF EXTENTS 40200000 ST R9,IDNOXS 40500000 SLL R9,3 MULTIPLY BY 8 40800000 LA R9,8(R9) ADD 8 41100000 ST R9,IDXLEN STORE LENGTH OF EXTENT LIST 41400000 LH R9,CMNUMXS GET NUMBER OF EXTENTS AGAIN 41700000 LR R3,R9 42000000 SLL R9,2 NO. EXTENTS TIMES FOUR IS DIFFERENCE 42300000 * BETWEEN LENGTH AND ADDRESS FIELDS 42600000 * IN EXTENT LIST 42900000 * 43200000 * FIRST EXTENT IS LOADER LOADED TEXT 43500000 * 43800000 L R5,CMMAINPT FIRST EXTENT ADDRESS IN R5 44100000 L R6,CMNXTTXT LENGTH OF FIRST EXTENT 44400000 SR R6,R5 IN REGISTER 6 44700000 BAL R14,IDENTER MAKE ENTRY IN EXTENT LIST 45000000 * 45300000 * SECOND EXTENT IS MINI-CESD 45600000 * 45900000 AR R5,R6 GET ADDRESS OF MINI-CESD IN R5 46200000 L R10,CMLOWTBL GET UPPER LIMIT FOR MINI-CESD 46500000 BAL R14,IDMINI GO CONSTRUCT IT 46800000 TM CMFLAG4,CQMINI WAS IT BUILT 47100000 BO IDMINBLT YES 47400000 L R5,CMMAINPT NO. USE VALID DUMMY ADDRESS 47700000 SR R6,R6 SET LENGTH OF EXTENT =0 48000000 B ID9 GO ENTER EXTENT 48300000 IDMINBLT LA R6,7(R6) ROUND UP TO DOUBLE WORD 48600000 N R6,DBLMASK 48900000 ST R6,CMNXTTXT SAVE LAST TEXT ADDRESS 49200000 SR R6,R5 GET LENGTH 49500000 ID9 BAL R14,IDENTER ENTER MINI-CESD EXTENT 49800000 * 50100000 * REMAINING EXTENTS ARE COMPILER-LOADED TEXT 50400000 * 50700000 L R8,CMXLCHN NOW DO MOD EXTENTS 51000000 IDMODS L R5,4(R8) GET ADDRESS 51300000 L R6,8(R8) GET LENGTH 51600000 BAL R14,IDENTER GO ENTER EXTENT 51900000 L R8,0(R8) GET NEXT IN CHAIN 52200000 B IDMODS 52500000 * 52800000 * ENTER EXTENT ADDRESS AND LENGTH IN EXTENT LIST 53100000 * 53400000 IDENTER ST R6,IDXTNT STORE LENGTH 53700000 ST R5,IDXTNT(R9) STORE ADDRESS 54000000 BCT R3,IDENTOUT ARE WE THRU WITH EXTENT LIST 54300000 MVI IDXTNT,X'80' YES. FLAG LAST ENTRY 54600000 B IDID GO DO IDENTIFY 54900000 IDENTOUT LA R7,4(R7) 55200000 BR R14 NO. RETURN TO GET ANOTHER EXTENT 55500000 * 55800000 * ISSUE IDENTIFY MACRO 56100000 * 56400000 IDID L R1,CMLOWTBL POINT TO PARAMETER LIST 56700000 IDENTIFY MF=(E,(1)) IDENTIFY LOADED PROGRAM 57000000 LTR R15,R15 OKAY 57300000 BNZ IDBAD ERROR CODE REC'D FROM IDENTIFY 57600000 OI CMFLAG4,CQIDONE SHOW IDENTIFICATION ACCOMPLISHED 57700000 * 57900000 * RETURN TO CALLER 58200000 * 58500000 IDOUT L R13,4(R13) RETURN 58800000 RETURN (14,12),T 59100000 * 59400000 * ERROR CONDITIONS 59700000 * 60000000 IDBAD LA R1,8 ERROR CODE FROM IDENTIFY 60300000 LA R0,ERIDEN1 LOAD ERROR CODE 60600000 CR R15,R1 WAS THIS DUPLICATE NAME 60900000 BE IDERR YES. 61200000 LA R0,ERIDEN2 LOAD ERROR CODE 61500000 IDERR LA R1,CMPGMNM PRINT OUT NAME AND RETURN CODE 61800000 B IDERROR 62100000 IDTOOBIG LA R0,ERSIZE2 PROGRAM TOO LARGE 62400000 IDERROR L R15,ADRERROR GO TO LOG ERROR 62700000 BALR R14,R15 63000000 B IDOUT AND LEAVE 63300000 * 63600000 * THIS ROUTINE CONSTRUCTS MINI-CESD FOR TEST PACKAGE IF 63900000 * TSO IS OPERATING 64200000 * IT EXPECTS - R5=STARTING ADDR FOR MINI-CESD 64500000 * R10=UPPER LIMIT OF CORE AVAILABLE 64800000 * IT RETURNS - R5=AS IS 65100000 * R6=LENGTH OF EXTENT 65400000 * R10,R1,R2=DESTROYED 65700000 * FLAG 'CQMINI' IN 'CMFLAG4' SET IF BUILD OK 66000000 * SEE IEWLRELO FOR CHAIN SETUP 66300000 * 66600000 IDMINI TM CMFLAG3,CQTS IS THIS TSO 66900000 BZ IDNOMINI NO. DON'T CONSTRUCT MINI-CESD 67200000 LA R2,12 ADJUST REGISTER 10(UPPER LIMIT) 67500000 SR R10,R2 TO MAKE OVERFLOW CHECK EASIER 67800000 LR R6,R5 GET STARTING ADDRESS 68100000 LA R2,MINITYPE TYPES TO GO IN MINI-CESD 68400000 IDMINI3 IC R1,0(R2) GET FIRST TYPE 68700000 N R1,TYPEONLY GET ITS INDEX INTO CHAIN TABLE 69000000 SLL R1,2 69300000 LA R1,CMTYPCHN(R1) GET POINTER TO ITS CHAIN 69600000 IDMINI4 L R1,0(R1) MOVE UP IN CHAIN 69900000 LTR R1,R1 ARE WE AT END OF CHAIN 70200000 BNZ IDMINI5 NO. PROCESS THIS ENTRY 70500000 TM 0(R2),X'80' YES. IS THERE ANOTHER TYPE 70800000 BO IDMINI6 NO. WE'RE DONE 71100000 LA R2,1(R2) YES. POINT TO NEXT TYPE 71400000 B IDMINI3 71700000 IDMINI5 CR R6,R10 WILL THIS ENTRY FIT 72000000 BH IDNOMINI NO. ABORT MINI-CESD 72300000 MVC 0(12,R6),4(R1) YES. MOVE IN NAME,TYPE AND ADDR 72600000 NI 8(R6),X'07' AND OUT ALL FLAGS BUT TYPE 72700000 LA R6,12(R6) MOVE UP IN MINICESD 72900000 B IDMINI4 UP TABLE ADDRESS 73200000 IDMINI6 OI CMFLAG4,CQMINI SET FLAG 'MINI BUILT' 73500000 IDNOMINI BR R14 RETURN 73800000 DS 0F 74100000 DBLMASK DC X'FFFFFFF8' TO ROUND TO DOUBLEWORD 74400000 TYPEONLY DC F'00000007' TO ISOLATE TYPE IN CESD 74700000 MINITYPE DC X'0085' SD AND CM WANTED FOR MINI-CESD 75000000 ADRERROR DC V(IEWERROR) ADDRESS OF ERROR ROUT 75300000 * 75600000 * IDENTIFY PARAMETER LIST 75900000 * 76200000 IDPARM DSECT IDENTIFY PARAMETER LIST DSECT 76500000 IDEP DS F ENTRY POINT ADDRESS 76800000 IDNAM DS CL8 PROGRAM NAME 77100000 IDXLEN DS F EXTENT LIST LENGTH 77400000 IDNOXS DS F NUMBER OF EXTENTS 77700000 IDXTNT EQU * EXTENT LENGTHS AND ADDRESSES 78000000 PATCH DS 10F MAINTENANCE AREA 78100000 EJECT 78300000 IEWLDCOM 78600000 END 78900000 ./ ADD SSI=00011351,NAME=IEWLDIOC,SOURCE=0 IOCA TITLE 'INPUT/OUTPUT - CONTROL - ALLOCATION MODULE FOR THE OS/3X00050000 60 LOADER' 00100000 *********************************************************************** 00150000 * * 00200000 *TITLE 'IEWLIOCA' - I/O, CONTROL, AND ALLOCATION MODULE FOR THE * 00250000 * OS/360 LOADER * 00300000 * * 00350000 *STATUS - CHANGE LEVEL 20 00370000 * TSO CHANGES FOR IDENTIFICATION,TERM OPTION AND INCORE DS * 00390000 * SECOND BASE REGISTER (4) ADDED * 00410000 * * 00450000 *FUNCTION/OPERATION- THIS MODULE PERFORMS THE FOLLOWING - * 00500000 * 1. ISSUES AN UNCONDITIONAL 6K GETMAIN FOR INITIALIZATION A42698* 00550021 * 1A. ISSUES AN EXTRACT TO FIND WHETHER TSO IS OPERATING * 00580000 * 2. SCANS THE OPTION,DDNAME AND DCB LISTS * 00610000 * 3. ISSUES A VARIABLE CONDITIONAL GETMAIN FOR PROGRAM AND TABLES * 00650000 * 4. ALLOCATES AND INITIALIZES THE LOADER COMMUNICATION AREA * 00700000 * 4A. SETS SYSPRINT RECORD SIZE AT 81 OR 121 DEPENDING ON WHETHER * 00710000 * TSO IS OPERATING * 00720000 * 5. ALLOCATES AND CHAINS SAVE AREAS FOR USE DURING LOADING * 00750000 * 6. FREEMAINS THE INITIAL 4K STORAGE FOR USE BY DATA MANAGEMENT * 00800000 * 7. CONSTRUCTS SYSLIN AND SYSPRINT DCBS * 00850000 * 7A.ALLOCATES SPACE FOR SYSTERM DCB,DECBS, AND BUFFERS * 00870000 * 8. OPENS SYSLIN AND SYSPRINT DCBS * 00900000 * 9. CALLS IEWBUFFR (SEE BELOW) TO ALLOCATE SYSPRINT BUFFERS * 00950000 * 10. PRINTS LOADER HEADING, OPTIONS USED, REJECTED OPTIONS, ERRORS * 01000000 * ENCOUNTERED DURING OPEN, AND MAP HEADING * 01050000 * 11. CALLS IEWBUFFR (SEE BELOW) TO ALLOCATE SYSLIN BUFFERS * 01100000 * 12. CALLS IEWPRIME (SEE BELOW) TO PRIME OBJECT MODULE BUFFERS * 01150000 * 13. CALLS IEWLRELO TO PROCESS OBJECT MODULES * 01200000 * 14. CALLS IEWLODE TO PROCESS LOAD MODULES * 01250000 * 15. CALLS IEWACALL TO PROCESS AUTO-CALL AND FINAL RESOLUTION * 01300000 * 15A. CALLS IEWLIDEN TO PERFORM IDENTIFICATION * 01320000 * 16. CALLS IEWBTMAP TO PROCESS THE DIAGNOSTIC MESSAGE DICTIONARY * 01350000 * 17. PURGES THE SYSPRINT BUFFERS * 01400000 * 18. CLOSES DATA SETS * 01450000 * 19. FREEMAINS STORAGE NOT ALLOCATED TO THE LOADED PROGRAM * 01500000 * 20. CONSTRUCTS RETURN PARAMETERS * 01550000 * 21. RETURNS TO THE INVOKING PROGRAM * 01600000 * * 01650000 *ENTRY POINTS -'IEWLOAD'- MAIN ENTRY POINT FOR ALIAS IEWLOAD * 01670000 * LOADING WITH IDENTIFICATION * 01690000 * 'IEWLIOCA'- ENTRY POINT FOR IEWLOADR * 01710000 * LOADING WITHOUT IDENTIFICATION * 01730000 * 'IEWOPNLB' - CLOSES SYSLIN DATA SET * 01750000 * - OPENS SYSLIB DATA SET * 01800000 * - CALLS IEWBUFFR (SEE BELOW) TO ALLOCATE SYSLIB BUFFERS* 01850000 * * 01900000 * 'IEWBUFFR' - DEALLOCATES ANY PREVIOUS INPUT BUFFERS AND DECBS * 01950000 * - ALLOCATES BUFFERS AND DECBS FOR DCB SPECIFIED * 02000000 * - RESETS INPUT I/O FLAGS * 02050000 * * 02100000 * 'IEWPRIME' - ISSUES A 'READ' ON ALL INPUT BUFFERS EXCEPT ONE * 02150000 * - SETS DATA LENGTH TO ZERO ON BUFFER NOT READ * 02200000 * - SETS INPUT RECORD POINTER TO ZERO-LENGTH BUFFER * 02250000 * * 02300000 * 'IEWLREAD' - READS PHYSICAL RECORDS (BSAM) * 02350000 * - DEBLOCKS INCORE DATA SET * 02370000 * - DEBLOCKS FIXED RECORD FORMAT * 02400000 * * 02450000 * 'IEWLPRNT' - INSERTS ASA CARRIAGE CONTROL CHARACTERS IN RECORDS * 02500000 * - BLOCKS LOGICAL RECORDS INTO PHYSICAL RECORDS * 02550000 * - WRITES PHYSICAL RECORDS * 02600000 * * 02610000 * 'IEWTERM' - OPENS SYSTERM IF NOT OPEN * 02620000 * WRITES PHYSICAL RECORDS (BSAM) * 02630000 * * 02650000 *INPUT- STANDARD OS/360 PARAMETER LIST * 02700000 * * 02750000 *OUTPUT- REGISTER 15 - RETURN CODE * 02800000 * REGISTER 0 - ENTRY POINT ADDRESS OF LOADED PROGRAM * 02850000 * REGISTER 1 - POINTER TO TWO FULL WORDS * 02900000 * WHEN INVOKED VIA IEWLOAD * 02910000 * TWO WORDS CONTAIN NAME OF IDENTIFIED PROGRAM * 02920000 * EITHER AS SPECIFIED IN NAME PARAMETER OR DEFAULT **GO * 02930000 * WHEN INVOKED VIA IEWLOADR * 02940000 * WORD1 - BEGINNING ADDRESS OF STORAGE OCCUPIED BY PROGRAM * 02950000 * WORD2 - EXTENT (IN BYTES) OF PROGRAM * 03000000 * * 03050000 *EXTERNAL ROUTINES- * 03100000 * * 03150000 * 'IEWERROR' - LOG ERROR MESSAGES * 03200000 * 'IEWLRELO' - PROCESS OBJECT MODULES * 03250000 * 'IEWLOAD ' - PROCESS LOAD MODULES * 03300000 * 'IEWACALL' - PROCESS AUTO-CALL AND FINAL RESOLUTION * 03350000 * 'IEWBTMAP' - CONSTRUCT THE DIAGNOSTIC MESSAGE DICTIONARY * 03400000 * 'IEWLDDEF' - USED TO OBTAIN DEFAULT OPTIONS AND DDNAMES * 03450000 * 'IEWLIDEN' - USED TO PERFORM IDENTIFICATION TO SYSTEM * 03470000 * * 03500000 *EXITS-NORMAL- RETURN TO CALLER VIA REGISTER 14 - REG 15 = 0 * 03550000 * -ERROR- RETURN TO CALLER VIA REGISTER 14 - ERROR CODE IN REG 15 * 03600000 * * 03650000 *TABLES/WORK AREAS- * 03700000 * 'IEWLDCOM' - ALL COMMUNICATION INFORMATION * 03750000 * 'DCB ' - INPUT AND OUTPUT DCBS * 03800000 * 'DECB ' - INPUT AND OUTPUT DECBS * 03850000 * * 03900000 *ATTRIBUTES- REFRESHABLE,REENTRANT,REUSABLE * 03950000 * * 04000000 *NOTES - TWO BASE REGISTERS USED - 12 AND 4 * 04030000 * SYSLOUT SHOULD BE SUBSTITUED FOR SYSPRINT * 04060000 * * 04100000 * MAINTANCE CHANGES 04110021 * 04120021 * PTM 3177 FREEMAIN WITH NO EXTENTS $352740,353060 04130021 * 04140021 *********************************************************************** 04150000 EJECT 04200000 * OS/360 LOADER --- MAIN ENTRY POINT 04250000 * 04300000 IEWLIOCA CSECT 04350000 *C005500,809500 A42698 04360021 * FIX IS INCORPORATED IN FIX TO A42698 M1488 04362021 *A061850 SA41067 04370000 * SA49491 04390000 *A683100-684300 SA69255 04392021 SAVE (14,12),,IEWLOADR SAVE CALLERS REGISTERS 04400000 LR R12,R15 MOVE EP BASE 04450000 USING IEWLIOCA,R12 AND IDENTIFY IT 04500000 LR R3,R1 MOVE PARAMETER REGISTER 04550000 L R4,IOCABSE2 LOAD SECOND BASE REGISTER 04560000 USING IEWLIOCA+4096,R4 04570000 * 04600000 GETMAIN R,LV=DMSIZE,SP=0 GETMAIN FOR INITIALIZATION 04650000 * 04700000 LR R10,R1 MOVE POINTER TO ADDRESSING REGISTER 04750000 USING INITMAIN,R10 AND IDENTIFY IT 04800000 USING ERCODES,0 IDENTIFY ERROR CODE DSECT 04850000 * 04900000 SR R2,R2 SET FORWARD CHAIN 04950000 ST R2,INITSAVE+8 TO ZERO IN MY SAVE AREA 05000000 ST R13,INITSAVE+4 SET BACKWARD CHAIN TO PREV SAVE 05050000 LA R5,INITSAVE SET PREVIOUS SAVE AREA'S 05100000 ST R5,8(R13) FORWARD CHAIN TO ME 05150000 LR R13,R5 MOVE MY SAVE POINTER TO R13 05200000 * 05250000 * MOVE DEFAULT OPTIONS AND DDNAMES INTO 'INITMAIN' DSECT 05300000 * 05350000 L R9,DFLTBASE GET POINTER TO DEFAULTS CSECT 05400000 USING DEFAULTS,R9 AND IDENTIFY IT 05450000 SPACE 05500000 MVC INITDDNM(24),DFLTDDNM MOVE DEFAULT DDNAMES 05550000 MVC INITDDNM+24(8),DFLTTERM MOVE DEFAULT SYSTERM DDNAME 05570000 MVC INITRMAX(4),DFLTSIZE MOVE DEFAULT SIZE 05600000 MVC INITRMIN(4),DFLTMIN MOVE MIN SIZE (NOT IN IEWLDDEF) 05650000 MVC INITPARM(2),DFLTFLAG MOVE DEFAULT OPTIONS 05700000 MVC INITPGMN(8),DFLTNAME STORE DEFAULT PROGRAM NAME 05710000 XC INFLAG3(2),INFLAG3 ZERO OUT FLAGS 05720000 DROP R9 05750000 SPACE 05800000 MVI INITNAME,C' ' BLANK OUT 05850000 MVC INITNAME+1(7),INITNAME ENTRY POINT NAME FIELD 05900000 * 05950000 MVC INITEXTR(EXTRLEN),EXTR MOVE EXTRACT PARM LIST 05954000 EXTRACT INITEXAD,MF=(E,INITEXTR) 05962000 L R6,INITEXAD GET IT 05970000 LTR R6,R6 WAS IT DEFINED 05974000 BZ MNINIT NO. BRANCH 05978000 TM 0(R6),TCBTSTSK YES. IS IT TIME-SHARING TASK 05982000 BNO MNINIT NO. DON'T SET TSO FLAG 05986000 OI INFLAG3,CQTS SET ON TIME-SHARING FLAG 05990000 MNINIT EQU * 05994000 LA R6,INITREJP INITIALIZE INVALID OPTIONS 06000000 ST R6,INITREJL BUFFER ADDRESS 06050000 * 06100000 * SCAN PARAMETER LIST PASSED IN R1 06150000 LR R1,R3 DID WE ENTER VIA IEWLOAD 06157000 N R1,ENTFLG2 06164000 C R1,ENTFLG2 06171000 BNE MNPARSE NO. LEAVE IDEN FLAG OFF 06178000 OI INFLAG3,CQIDEN YES. SHOW IDENTIFICATION WANTED 06185000 SR R1,R1 CLEAR REGISTER ONE A41067 06188021 MNPARSE EQU * 06192000 * 06200000 L R11,0(R3) GET POINTER TO LIST 06250000 * 06300000 LH R5,0(R11) GET LIST LENGTH 06350000 LTR R5,R5 IS THE SIZE ZERO 06400000 BZ MNCKDDNM YES - NO PARAMETERS 06450000 * 06500000 SR R8,R8 ZERO OUT 06550000 SR R7,R7 THE TRANSLATE 06600000 STM R7,R8,INITRTAB AND TEST 06650000 MVC INITRTAB+8(256-8),INITRTAB TABLE 06700000 MVI INITRTAB+C',',C',' MOVE IN COMMA FOR DELIM 06750000 MVI INITRTAB+C'=',C'=' AND = FOR DELIM 06800000 * 06850000 LA R11,2(R11) POINT TO LIST 06900000 BCTR R5,0 DECREMENT COUNT FOR EXECUTE 06950000 LA R14,MNSETCHK CONTINUE ADDRESS 07000000 LA R7,255 CHECK IF LENGTH OF OPTIONS 07050000 CR R5,R7 IS GREATER THAN 256 07100000 BNH MNPRMSCN LENGTH OK - GO SCAN 07150000 LR R5,R7 LENGTH GREATER - TRUNCATE TO 256 07200000 SPACE 07250000 * SCAN PARAMETER LIST TO A COMMA OR EQUAL SIGN 07300000 SPACE 07350000 MNPRMSCN EX R5,MNPRMTRT SCAN TO COMMA 07400000 BNZ MNPRMCHK AND CHECK PARM IF COMMA FOUND 07450000 LA R1,1(R11,R5) SIMULATE COMMA FOUND IF END 07500000 MNPRMCHK SR R1,R11 GET SIZE OF PARM 07550000 BCTR R1,0 DECRIMENT FOR EXECUTE 07600000 BZ MNNXTPRM NO PARM IF LENGTH ZERO 07650000 BR R14 DROP THROUGH IF KEYWORD -- 07700000 * RETURN TO 'MNSIZE' OR 'MNEP' 07750000 * IF OPERAND 07800000 SPACE 07850000 MNSETCHK LM R7,R9,SCANCTRL LOAD CONTROL WORDS FOR LIST COMPARE 07900000 SPACE 2 07950000 * COMPARE OPTION IN PARAMETER LIST AGAINST VALID OPTIONS 08000000 SPACE 08050000 MNNXTCHK SR R2,R2 LOCATE 08100000 IC R2,0(R7) ENTRY 08150000 LA R14,PARMLIST(R2) IN VALID OPTION LIST 08200000 EX R1,LENTHCHK IS LENGTH IN LIST EQ LENGTH OF OPT'N 08250000 BNE MNNXTINC NO - CHECK NEXT OPTION 08300000 EX R1,PARMSCAN COMPARE AGAINST OPTION IN USER LIST 08350000 BE MNPARMEQ OPTION EQUAL -- GO PROCESS IT 08400000 SPACE 08450000 MNNXTINC BXLE R7,R8,MNNXTCHK NOT THIS OPTION - CHECK NEXT IF ONE 08500000 SPACE 08550000 * THE PARAMETER HAS BEEN REJECTED -- PUT INVALID OPTION ONTO LIST 08600000 SPACE 08650000 MNREJECT EX R1,MVREJECT MOVE INVALID OPTION TO BUFFER 08700000 AR R6,R1 UPDATE ADDRESS IN BUFFER 08750000 MVI 1(R6),C',' MOVE COMMA IN 08800000 LA R6,2(R6) COMPENSATE FOR COMMA AND BCTR 08850000 B MNNXTPRM GO TO PROCESS NEXT OPTION 08900000 SPACE 2 08950000 * A MATCH HAS BEEN FOUND -- PERFORM OPERATION DEFINED BY 'SCANLIST' 09000000 SPACE 09050000 MNPARMEQ IC R2,3(R7) PICK UP INDEX INTO EXECUTE LIST 09100000 IC R8,1(R7) PICK UP FUNCTION BYTE 09150000 EX R8,SETPARM(R2) AND PERFORM OPERATION 09200000 SPACE 09250000 MNNXTPRM LA R14,MNSETCHK ESTABLISH CHECK FOR NEW KEYWORD 09300000 MNOPRAND LA R1,2(R1) ADD TO LENGTH FOR COMMA AND BCTR 09350000 AR R11,R1 ADD LENGTH TO PREV ADDRESS 09400000 SR R5,R1 SUBTRACT LENGTH FROM LIST LENGTH 09450000 BNM MNPRMSCN AND GO SCAN NEXT IF THERE 09500000 * 09550000 ST R6,INITREJL SAVE END OF REJECTED OPTIONS LIST 09600000 B MNCKDDNM AND GO CHECK FOR DDNAMES 09650000 * 09700000 * SCAN OFF ENTRY NAME AND MOVE IT TO 'INITMAIN' 09750000 * 09800000 MNEP BAL R14,MNOPRAND ENTRY POINT NAME -- SCAN OFF OPERAND 09850000 LR R8,R1 MOVE OPERAND LENGTH 09900000 LA R7,7 MAXIMUM LENGTH FOR NAME 09950000 CR R8,R7 IS LENGTH SPECIFIED OK 10000000 BNH MNEPOK LOW OR EQUAL IS OK 10050000 LR R8,R7 MAKE NAME LENGTH = 8 CHARS 10100000 MNEPOK EX R8,MOVEPNM MOVE ENTRY POINT NAME 10150000 OI INITPARM,CQEPNAME SET NAME SPECIFIED FLAG 10200000 B MNNXTPRM AND SCAN NEXT 10250000 * 10253000 * 10256000 MNNAME BAL R14,MNOPRAND PROGRAM NAME - SCAN OFF OPERAND 10259000 MVI INITPGMN,C' ' BLANK OUT 10262000 MVC INITPGMN+1(7),INITPGMN PROGRAM NAME FIELD 10265000 LR R8,R1 MOVE OPERAND LENGTH 10268000 LA R7,7 MAXIMUM LENGTH FOR NAME 10271000 CR R8,R7 IS LENGTH SPECIFIED OK 10274000 BNH MNNAMEOK LOW OR EQUAL IS OK 10277000 LR R8,R7 MAKE LENGTH = 8 CHARACTERS 10280000 MNNAMEOK EX R8,MOVPGMNM MOVE PROGRAM NAME 10283000 OI INFLAG3,CQPGMNM SHOW PROGRAM NAME REC'D 10286000 B MNNXTPRM AND SCAN NEXT. 10289000 * 10300000 * SCAN OFF SIZE OPERAND AND MOVE IT OVER DEFAULT IN 'INITMAIN' 10350000 * 10400000 MNSIZE BAL R14,MNOPRAND SIZE SPECIFIED -- SCAN OFF OPERAND 10450000 ST R11,INITDUM SAVE POINTER TO OPERAND 10500000 LR R9,R1 AND LENGTH 10550000 SPACE 10600000 ST R1,INITSCAN SAVE SCAN POINTER 10650000 SPIE SPIEEXIT,(7) SPIE FOR DATA EXCEPTION 10700000 ST R1,INITSPIE SAVE PREVIOUS PICA ADDRESS 10750000 SPACE 10800000 LA R1,1 PUT 1 INTO REG FOR INCR - DECR 10850000 CLI 0(R11),C'(' IS FIRST CHAR A PAREN 10900000 BNE MNSIZE1 NO - GO AROUND 10950000 AR R11,R1 YES - BUMP POINTER OVER IT 11000000 SR R9,R1 DECRIMENT COUNT 11050000 BM SPIEEXIT INVALID IF COUNT ZERO 11100000 MNSIZE1 LA R8,0(R9,R11) POINT TO END OF OPERAND 11150000 CLI 0(R8),C')' IS LAST CHAR A PAREN 11200000 BNE MNSIZE2 NO - GO AROUND 11250000 SPACE 11300000 SR R8,R1 YES - BACK UP OVER PAREN 11350000 SR R9,R1 DECRIMENT LENGTH 11400000 BM SPIEEXIT INVALID IF LENGTH ZERO 11450000 MNSIZE2 CLI 0(R8),C'K' IS IT A 'K' TYPE SIZE 11500000 BNE MNSIZE3 NO - GO AROUND 11550000 SPACE 11600000 SR R9,R1 YES - DECRIMENT LENGTH 11650000 BM SPIEEXIT INVALID IF COUNT ZERO 11700000 SPACE 11750000 MNSIZE3 EX R9,PACKSIZE PACK THE DIGITS 11800000 OI INITSIGN,X'0F' INSURE SIGN IS POSITIVE 11850000 CVB R2,INITDBLW AND CONVERT TO BINARY 11900000 CLI 0(R8),C'K' IS 'K' VALUE SPECIFIED 11950000 BNE MNSIZE4 NO - GO AROUND 12000000 SPACE 12050000 SLL R2,10 YES -- MULTIPLY RESULT BY K (1024) 12100000 MNSIZE4 C R2,INITRMIN IS SIZE SPECIFIED GREATER THAN MIN 12150000 BH MNSIZE6 YES - OK 12200000 SPACE 12250000 MNSIZE5 L R2,INITRMIN NO - SUBSTITUTE MINIMUM SIZE 12300000 MNSIZE6 ST R2,INITRMAX STORE RESULT INTO MAX REQUEST 12350000 SPACE 12400000 MNSIZE7 LA R14,MNNXTPRM SPIE EXIT NOT TAKEN 12450000 MNSIZE8 L R1,INITSPIE PICK UP PREVIOUS PICA ADDRESS 12500000 SPIE MF=(E,(1)) RE-SPIE IT 12550000 L R1,INITSCAN RELOAD SCAN POINTER 12600000 L R11,INITDUM RELOAD OPERAND POINTER 12620000 BR R14 AND GO SCAN NEXT OPTION 12650000 SPACE 2 12700000 SPIEEXIT MVC 0(5,R6),VPSIZE INVALID SIZE OPERAND -- MOVE 12750000 LA R6,5(R6) 'SIZE=' TO REJECTED OPTIONS BUFFER 12800000 LA R14,MNREJECT FIX SO OPERAND IS MOVED 12850000 B MNSIZE8 AND GIVE DEFAULT SIZE 12900000 SPACE 3 12950000 * CHECK IF DDNAMES PASSED AND MOVE THEM OVER DEFAULTS IN 'INITMAIN' 13000000 SPACE 2 13050000 MNCKDDNM TM 0(R3),X'80' IS THIS THE END OF LIST 13100000 BO MNVCGTMN YES - NO DDNAMES PASSED 13150000 * 13200000 L R2,4(R3) NO. GET 13250000 LH R5,0(R2) GET COUNT 13300000 LTR R5,R5 IS COUNT ZERO 13350000 BZ MNCHKDCB 13400000 * 13450000 LA R2,2(R2) POINTER TO BEGINNING 13500000 LA R6,INITLIN POINTER TO DEFAULT IN LOADER 13550000 LA R7,0 DISPLACEMENT IN DDNAME LIST 13600000 BAL R14,MNMVDDNM CHECK IF SYSLIN DEFINED 13650000 * 13700000 LA R6,INITLIB POINTER TO DEFAULT IN LOADER 13750000 LA R7,24 DISPLACEMENT IN DDNAME LIST 13800000 BAL R14,MNMVDDNM CHECK IF SYSLIB DEFINED 13850000 * 13900000 LA R6,INITPRNT POINTER TO DEFAULT IN LOADER 13950000 LA R7,40 DISPLACEMENT IN DDNAME LIST 14000000 BAL R14,MNMVDDNM CHECK IF SYSPRINT DEFINED 14050000 LA R6,INITTERM POINTER TO DEFAULT IN LOADER 14060000 LA R7,88 DISPLACEMENT IN DDNAME LIST 14070000 BAL R14,MNMVDDNM CHECK IF SYSTERM DEFINED 14080000 * 14100000 MNCHKDCB TM 4(R3),X'80' WERE DDNAMES LAST ENTRY 14103000 BO MNVCGTMN YES. 14106000 TM 8(R3),X'80' PG HDG LAST 14109000 BO MNVCGTMN YES 14112000 L R2,12(R3) DCBS PASSED 14115000 L R5,0(R2) GET NO ENTRIES IN LIST 14118000 LTR R5,R5 IS COUNT 0 14121000 BZ MNVCGTMN YES. NO DCBS PASSED 14124000 L R6,4(R2) TRY SYSLIN 14127000 LTR R6,R6 IS A DCB PASSED 14130000 BZ MNCKLIB NO. CHECK SYSLIB 14133000 USING IHADCB,R6 14136000 CLI DCBDEVT,X'00' IS IT INCORE 14139000 BNE MNCKLIB NO. IGNORE IT 14142000 OI INFLAG3,CQINCORE+CQPASLIN 14145000 ST R6,INLINDCB SAVE DCB ADDRESS 14148000 MNCKLIB LA R7,4 SYSLIB IS FOURTH ENTRY 14151000 CR R7,R5 IS IT POSSIBLY HERE 14154000 BH MNVCGTMN NO 14157000 L R6,16(R2) YES. PICK IT UP 14160000 LTR R6,R6 IS IT REALLY HERE 14163000 BZ MNVCGTMN NO. WEHRE THRU WITH PARMS 14166000 TM DCBOFLGS,DCBOPEN IS IT OPEN 14169000 BZ MNVCGTMN NO. IGNORE IT 14172000 OI INFLAG3,CQPASLIB YES. SET FLAG 14175000 ST R6,INLIBDCB SAVE DCB ADDRESS 14178000 B MNVCGTMN 14181000 * 14200000 * 14250000 MNMVDDNM LA R8,8(R7) IS LENGTH OF NAME PLUS DISPLACEMENT 14300000 CR R8,R5 IN LIST GREATER THAN LIST LENGTH 14350000 BCR 2,R14 YES - RETURN 14400000 * 14450000 AR R7,R2 NO. ADD DISPLACEMENT AND BEGIN 14500000 NC 0(8,R7),0(R7) IS DDNAME SPECIFIED ZERO 14550000 BCR 8,R14 YES - RETURN 14600000 * 14650000 MVC 0(8,R6),0(R7) NO - MOVE IN NEW DDNAME 14700000 BR R14 AND RETURN 14750000 * 14800000 MOVPGMNM MVC INITPGMN(0),0(R11) EXECUTED MOVE PROG NAME FROM LIST 14820000 MOVEPNM MVC INITNAME(0),0(R11) EXECUTED MOVE EPNAME FROM PARM LIST 14860000 MNPRMTRT TRT 0(0,R11),INITRTAB TRT FOR PARAMETER SCAN 14900000 PACKSIZE PACK INITDBLW(8),0(0,R11) EXECUTED PACK PARM SIZE 14940000 PARMSCAN CLC 0(0,R14),0(R11) COMPARE OPTION FOR MATCH 14980000 MVREJECT MVC 0(0,R6),0(R11) MOVE REJECTED OPTION TO BUFFER 15020000 REJTOCM MVC 0(0,R2),0(R6) MOVE REJECTED OPTIONS FROM INIT - CM 15100000 LENTHCHK CLI 2(R7),0 CHECK LENGTH OF OPTION 15150000 * 15200000 SETPARM DS 0F INDEXED EXECUTE LIST FOR OPTION SET 15250000 ORPARM OI INITPARM,0 SET BIT 15300000 ANDPARM NI INITPARM,0 CLEAR BIT 15350000 SIZEPARM B MNSIZE GO TO PROCESS SIZE 15400000 EPPARM B MNEP GO TO PROCESS ENTRY NAME 15450000 NAMEPARM B MNNAME GO TO PROCESS PROGRAM NAME 15453000 EJECT 15456000 * ENTRY POINT FOR IDENTIFICATION 15459000 USING IEWLOAD,R15 15462000 ENTRY IEWLOAD 15465000 IEWLOAD O R1,ENTFLG SHOW WE ENTERED HERE 15468000 L R15,IOCABASE NOW GO BACK TO IEWLOADR 15471000 BR R15 15474000 DC C'IEWLOAD ' 15477000 DS 0F 15480000 ENTFLG DC X'FF000000' 15483000 DROP R15 15486000 EJECT 15500000 *********************************************************************** 15550000 * * 15600000 * VARIABLE CONDITIONAL GETMAIN FOR PROGRAM AND TABLES * 15650000 * * 15700000 *********************************************************************** 15750000 SPACE 2 15800000 MNVCGTMN GETMAIN VC,LA=INITRMIN,A=INITMADR,SP=0,MF=(E,INITGTML) 15850000 * 15900000 * 15950000 LTR R15,R15 WAS MAIN STORAGE ALLOCATED 16000000 BZ MNMAINOK YES - ALL OK 16050000 * 16100000 GETMAIN R,LV=MINREQ,SP=0 GO OUT ON GETMAIN ERROR 16150000 LA R2,MINREQ SIMULATE VC ALLOCATED 16200000 STM R1,R2,INITMADR IF UNCONDITIONAL WORKED 16250000 SPACE 2 16300000 * SET UP BASE ADDRESS FOR THE COMMUNICATION AREA (IEWLDCOM) AND 16350000 * INITIALIZE IT 16400000 SPACE 16450000 MNMAINOK L R11,INITMADR PICK UP POINTER TO ALLOCATED CORE 16500000 LA R9,CQCMSIZE SIZE OF STATIC COMMUNICATION AREA 16550000 A R11,INITMSIZ ADD ALLOCATED CORE SIZE TO POINTER 16600000 SR R11,R9 SUBTRACT OFF SIZE OF COM AREA 16650000 * 16700000 USING IEWLDCOM,R11 IDENTIFY COMMUNICATION AREA BASE 16750000 * 16800000 MVC CMINITCM(INITCMSZ),INITCMCM MOVE COMMON AREA FROM 16850000 * INITIAL AREA TO 16900000 * COMMUNICATION AREA 16950000 SR R2,R2 INITIALIZE THE 17000000 SR R3,R3 REST OF THE 17050000 STM R2,R3,CMINTZRO COMMUNICATION AREA 17100000 MVC CMINTZRO+8(CQINTSIZ-8),CMINTZRO TO ZERO 17150000 * 17200000 ST R11,CMLOWTBL COMMUNICATION BASE IS LOWEST TABLE 17250000 AR R9,R11 COMMUNICATION SIZE + BASE 17300000 ST R9,CMHITBL IS HIGHEST ALLOCATED CORE 17350000 * 17400000 L R2,CMMAINPT PICK UP BEGINNING OF ALLOC CORE 17450000 MVC 0(8,R2),CMPGMNM MOVE PROGRAM NAME IN 17470000 LA R2,8(R2) ALLOW FOR RETURN PARMS 17500000 SR R3,R3 NEXT TWO WORDS MAY 17510000 ST R3,0(R2) MAY CONTAIN ADDR AND 17520000 ST R3,4(R2) LENGTH OF COMPILER- 17530000 LA R2,8(R2) LOADED TEXT 17540000 ST R2,CMNXTTXT AND STORE AS NEXT TEXT ADDRESS 17550000 ST R2,CMLSTTXT LAST TEXT ADDRESS 17600000 ST R2,CMBEGADR DEFAULT ENTRY POINT 17650000 ST R2,CMOBJST NEXT OBJ START SA49491 17652000 MNCKTSO TM CMFLAG3,CQTS ARE WE TIME-SHARING 17657000 BZ MN121 NO. 17664000 MVC CMMAPLIN(6),PRNT81 YES. 81 CHAR PRINT RECORD 17671000 B MNINITZR BRANCH OUT 17678000 MN121 MVC CMMAPLIN(6),PRNT121 121 PRINT RECORD 17685000 MNINITZR EQU * 17692000 * 17700000 * MOVE REJECTED OPTIONS FROM INITMAIN AND INITIALIZE CMERLIST 17750000 * 17800000 L R7,INITREJL GET END OF INVALID OPTIONS STRING 17850000 LA R8,7(R7) ROUND UP TO 17900000 N R8,DBLMASK DOUBLE WORD 17950000 LA R6,INITREJP LOAD POINTER OR INVALID OPTIONS 18000000 SR R8,R6 COMPUTE LENGTH OF LIST 18050000 AR R8,R2 ADD ADDRESS IN VC STORAGE 18100000 ST R8,CMERLIST AND STORE AS START OF ERROR L 18150000 SPACE 18200000 SR R7,R6 COMPUTE LENGTH OF INVALID OPTIONS 18250000 BZ MNALOCSV ZERO INDICATES NO LIST 18300000 SPACE 18350000 LH R8,CMMAXLST GET MAX LIST LENGTH 18400000 OI CMSTATUS,CQREJOPT SET LIST-PRESENT FLAG 18450000 CR R7,R8 IS LIST LENGTH GREATER THAN MAX 18500000 BNH MNREJOPT NO - MOVE ENTIRE LIST 18550000 SPACE 18600000 LR R7,R8 YES - TRUNCATE 18650000 MNREJOPT BCTR R7,0 18700000 BCTR R7,0 18750000 EX R7,REJTOCM MOVE THE INVALID OPTIONS TO SAVE 18800000 STC R7,CMOPTECT SAVE COUNT OF LIST 18850000 * 18900000 * ALLOCATE AND FORMAT SAVE AREAS TO BE USED THROUGHOUT LOADING 18950000 * 19000000 MNALOCSV LA R2,NUMSAVES NUMBER OF AREAS TO BE ALLOCATED 19050000 LA R0,72 SIZE OF EACH SAVE AREA 19100000 L R13,4(R13) POINTER TO CALLING PGM'S SAVE AREA 19150000 LR R9,R13 19200000 MNMORESV BAL R14,GETPRIME GET STORAGE FOR SAVE AREA 19250000 ST R9,4(R1) BACK CHAIN THIS TO LAST 19300000 ST R1,8(R9) FORWARD CHAIN LAST TO THIS 19350000 LR R9,R1 MAKE THIS EQUAL LAST 19400000 BCT R2,MNMORESV AND GET ANOTHER IF REQD 19450000 * 19500000 SR R1,R1 SET LAST FORWARD 19550000 ST R1,8(R9) CHAIN TO ZERO 19600000 L R13,8(R13) AND PICK UP FIRST AREA 19650000 ST R13,CMFSTSAV STORE AS FIRST SAVE AREA 19700000 * 19750000 * FREE THE INITIAL STORAGE FOR DATA MANAGEMENT 19800000 * 19850000 LR R1,R10 19900000 FREEMAIN R,LV=DMSIZE,A=(1),SP=0 19950000 * 19953000 * ALLOCATE SPACE FOR SYSTERM CONTROL BLOCKS AND BUFFER 19956000 * 19959000 TM CMPRMFLG,CQTERM WAS TERM OPTION WANTED 19962000 BNO MNSETDCB NO 19965000 LA R0,DCBSIZE+2*DECBSIZE+2*TRMBUFLN YES. GET SPACE 19968000 BAL R14,GETCORE FOR DCB,DECB AND BUFFERS 19971000 ST R1,CMTDCBPT SAVE POINTER TO DCB 19974000 LA R1,DCBSIZE(R1) 19977000 ST R1,CMTRMREC STORE POINTER TO 1ST BUFFER 19980000 MVI 0(R1),C' ' BLANK THE 19983000 MVC 1(TRMRECSZ-1,R1),0(R1) BUFFER 19986000 MNSETDCB EQU * 19989000 * 20000000 * MOVE SYSLIN AND SYSPRINT DCB'S TO GOTMAIN CORE AND INITIALIZE 20050000 * 20100000 OI CMSTATUS,CQMSGSAV SET REQ FOR OPEN-EXIT TO SAVE ERRORS 20150000 TM CMFLAG3,CQPASLIN IS SYSLIN PASSED 20158000 BZ MNLINDCB NO. GET DCB 20166000 L R10,CMLINDCB YES. PICK UP DUMMY DCB 20174000 ST R10,CMRDCBPT ASSUME INCORE 20182000 USING IHADCB,R10 20190000 SR R1,R1 ZERO OUT BUFFER POINTER 20198000 ST R1,CMGETREC FOR READ ROUTINE 20206000 TM CMPRMFLG,CQPRINT IS SYSPRINT REQUESTED 20214000 BO MNPRTDCB YES. GET DCB 20222000 B MNONEBUF NO. SKIP OPEN ENTIRELY 20230000 MNLINDCB LA R0,DCBSIZE DCB SIZE 20238000 BAL R14,GETCORE GET STORAGE FOR INPUT DCB 20250000 ST R1,CMRDCBPT STORE POINTER TO DCB 20300000 LR R10,R1 MOVE TO ADDRESSING REGISTER 20350000 USING IHADCB,R10 20400000 SPACE 20450000 MVC IHADCB(DCBSIZE),MODELDCB MOVE IN DCB MODEL 20500000 MVC DCBDDNAM(8),CMLINDD MOVE SYSLIN DDNAME TO DCB 20550000 MVC DCBDSORG(2),DSORGPS SET DCB SEQUENTIAL 20600000 MVC DCBMACR(2),MACRREAD AND INPUT 20650000 SPACE 20700000 O R1,OPENIN OR OPTION BYTE INTO DCB ADDRESS 20750000 ST R1,CMIOLST1 AND STORE INTO OPEN LIST 20800000 SPACE 20850000 TM CMPRMFLG,CQPRINT IS SYSPRINT REQUESTED 20900000 BZ MNOPENIN NO - GO OPEN SYSLIN ONLY 20950000 * 21000000 MNPRTDCB LA R0,DCBSIZE DCBSIZE 21020000 BAL R14,GETCORE GET STORAGE FOR OUTPUT DCB 21050000 ST R1,CMWDCBPT STORE POINTER TO DCB 21100000 LR R10,R1 MOVE TO ADDRESSING REGISTER 21150000 * 21200000 MVC IHADCB(DCBSIZE),MODELDCB MOVE IN DCB MODEL 21250000 MVC DCBDDNAM(8),CMPRNTDD MOVE IN SYSPRINT DDNAME 21300000 MVC DCBDSORG(2),DSORGPS SET DCB SEQUENTIAL 21350000 MVC DCBMACR(2),MACRWRTE AND OUTPUT 21400000 O R1,OPENOUT OR OPTION BYTE INTO DCB ADDRESS 21450000 TM CMFLAG3,CQPASLIN DO WE WANT TO OPEN SYSLIN 21460000 BZ MNBOTH YES. 21470000 ST R1,CMIOLST1 NO. PRINT ONLY 21480000 B MNOPE 21490000 MNBOTH ST R1,CMIOLST2 STORE DCB ADDRESS INTO OPEN LIST 21500000 NI CMIOLST1,X'7F' CLEAR LIST DELIMITER ON FIRST ENTRY 21550000 SPACE 21600000 *********************************************************************** 21650000 * * 21700000 * OPEN SYSLIN AND SYSPRINT DATA SETS * 21750000 * * 21800000 *********************************************************************** 21850000 SPACE 21900000 MNOPE OPEN MF=(E,CMIOLST1) 21950000 * 22000000 TM DCBOFLGS,DCBOPEN WAS SYSPRINT SUCCESSFULLY OPENED 22050000 BO MNALOCPR YES - ALLOCATE BUFFERS AND DECB'S 22100000 * 22150000 LA R0,DCBSIZE NO - GET DCB SIZE 22200000 LR R1,R10 AND ADDRESS 22250000 BAL R14,FREECORE AND FREE THE STORAGE 22300000 L R10,CMRDCBPT PICK UP POINTER TO INPUT DCB 22350000 B MNONEBUF AND GO CHECK IF OPEN 22400000 * 22450000 * 22500000 MNALOCPR OI CMSTATUS,CQPRTDCB IDENTIFY PRINT DCB OPEN 22550000 L R15,ADRBUFFR GET POINTER TO BUFFER ALLOCATION 22600000 BALR R14,R15 AND GO ALLOCATE BUFFERS 22650000 TM CMSTATUS,CQABORT TERMINATION ERROR OCCURR 22700000 BNZ MNIDEN AND GO CLOSE OUT 22750000 OI CMSTATUS,CQPRTOPN SET SYSPRINT ALLOCATED FLAG 22800000 SPACE 2 22850000 * INITIALIZE SYSPRINT DATA SET AND PRINT HEADINGS 22900000 SPACE 2 22950000 LA R1,50 SET MAXIMUM LINE COUNT 23000000 STH R1,CMMAXLNE TO 50 23050000 SPACE 23100000 L R9,CMWDECPT GET OUTPUT DECB POINTER 23150000 USING DECB,R9 AND IDENTIFY IT 23200000 SPACE 23250000 L R2,DECAREA GET BUFFER POINTER FOR THIS DECB 23300000 ST R2,CMPUTREC AND STORE AS FIRST LREC 23350000 SPACE 23400000 MVI 0(R2),C' ' SET UP 23450000 LH R15,CMWLRECL GET LENGTH OF RECORD 23470000 BCTR R15,0 SUBTRACT FIRST BYTE 23480000 BCTR R15,0 DECREMENT FOR EXECUTE 23490000 EX R15,MOVEHDNG CLEAR BUFFER 23520000 MVC 60-HDGLNGTH/2(HDGLNGTH,R2),LOADHEAD HEADING 23550000 MVI CMPRTCTL,CTEJECT EJECT BEFORE PRINT 23600000 L R15,ADRPRNT PRINT THE 23650000 BALR R14,R15 HEADING 'OS/360 LOADER' 23700000 SPACE 2 23750000 * CONSTRUCT LIST OF OPTIONS USED 23800000 SPACE 2 23850000 SR R1,R1 ZERO REGISTER USED FOR OPTION LENGTH 23900000 L R2,CMPUTREC GET POINTER TO BUFFER 23950000 MVC 1(OKOPTLNG,R2),OKOPTHDG MOVE PREFIX 'OPTIONS USED' 24000000 LA R2,1+OKOPTLNG(R2) AND UPDATE BUFFER POINTER 24050000 SPACE 24100000 LM R7,R9,OPTCNTRL GET CONTROL FOR LIST CONSTRUCTION 24150000 SPACE 24200000 MNMOVOPT IC R3,0(R7) PICK UP MASK FOR BIT TO TEST 24250000 IC R1,1(R7) PICK UP LENGTH OF OPTION NAME 24300000 LH R5,2(R7) AND INDEX TO OPTION NAME 24350000 LA R6,PARMLIST(R5) FORM ADDRESS FROM INDEX 24400000 EX R3,TESTOP TEST IF OPTION SPECIFIED 24450000 BO MNPOSOPT YES - PUT OUT OPTION NAME 24500000 SPACE 24550000 MVC 1(2,R2),NEGATE NO - PREFIX OPTION WITH 'NO' 24600000 LA R2,2(R2) AND UPDATE POINTER 24650000 SPACE 24700000 MNPOSOPT EX R1,MOVEOPT MOVE OPTION NAME TO PRINT BUFFER 24750000 LA R2,2(R1,R2) UPDATE BUFFER POINTER 24800000 MVI 0(R2),C',' AND INSERT COMMA AFTER IT 24850000 BXLE R7,R8,MNMOVOPT GO PUT OUT NEXT OPTION IF PRESENT 24900000 SPACE 2 24950000 * MOVE MAIN STORAGE SIZE RECEIVED INTO LIST 25000000 SPACE 2 25050000 MVC 1(5,R2),VPSIZE MOVE IN 'SIZE=' 25100000 LA R2,5(R2) UPDATE BUFFER POINTER 25150000 SPACE 25200000 L R6,CMMAINSZ GET SIZE RECEIVED FROM VC GETMAIN 25250000 CVD R6,CMXDBLWD CONVERT IT TO DECIMAL 25300000 UNPK 1(11,R2),CMXDBLWD(9) AND UNPACK IT INTO PRINT BUFFER 25350000 SPACE 25400000 LA R6,1(R2) SET UP FOR LEADING ZERO SCAN 25450000 LA R7,9(R2) COMPUTE END OF SIZE FIELD 25500000 SPACE 25550000 MNCKZERO CLI 0(R6),C'0' IS THE CHARACTER A ZERO 25600000 BNE MNMVSIZE NO - END OF SCAN 25650000 LA R6,1(R6) YES - UPDATE POINTER 25700000 B MNCKZERO AND GO CHECK NEXT CHARACTER 25750000 SPACE 25800000 MNMVSIZE SR R7,R6 GET LENGTH OF NON-ZERO SIZE 25850000 EX R7,MOVEOPT AND MOVE IT UP IN THE BUFFER 25900000 LA R2,1(R7,R2) UPDATE THE BUFFER POINTER 25950000 MVC 1(10,R2),11(R2) AND BLANK OUT ANY GARBAGE LEFT 26000000 SPACE 2 26006000 * MOVE PROGRAM NAME INTO LIST 26012000 SPACE 2 26018000 MVI 1(R2),C',' INSERT COMMA 26024000 MVC 2(5,R2),VPNAME MOVE IN 'NAME=' 26030000 MVC 7(8,R2),CMPGMNM AND SPECIFIED OR DEFAULT NAME 26036000 LA R2,14(R2) UPDATE THE BUFFER POINTER 26042000 SPACE 2 26050000 SPACE 26450000 PRINTOPT MVI CMPRTCTL,CTSPACE2 SPACE 2 BEFORE PRINT 26500000 L R15,ADRPRNT AND PRINT THE 26550000 BALR R14,R15 OPTIONS USED MESSAGE 26600000 SPACE 1 26603000 * NEW LINE FOR EP IF USED 26606000 SPACE 1 26609000 TM CMPRMFLG,CQEPNAME IS EP NAME SPECIFIED 26612000 BZ MNNOEP NO. BRANCH 26615000 L R2,CMPUTREC YES. GET NEW LINE 26618000 LA R2,1+OKOPTLNG(R2) INDENT 26621000 MVC 1(3,R2),VPEP MOVE IN 'EP=' 26624000 MVC 4(8,R2),CMEPNAME AND THE NAME SPECIFIED 26627000 L R15,ADRPRNT AND PRINT 26630000 BALR R14,R15 THIS LINE 26633000 MNNOEP EQU * 26636000 SPACE 2 26650000 * PRINT THE INVALID OPTIONS 26700000 SPACE 2 26750000 TM CMSTATUS,CQREJOPT ANY INVALID OPTIONS 26800000 BZ MNOPNMSG NO - GO CHECK FOR OPEN ERRORS 26850000 SPACE 26900000 L R2,CMPUTREC YES - GET PRINT BUFFER ADDRESS, 26950000 L R3,CMNXTTXT POINTER TO ERRORS, 27000000 IC R1,CMOPTECT AND BYTE COUNT 27050000 MVC 1(REJOPTLG,R2),REJOPT MOVE IDENTIFIER 27100000 EX R1,MVREJOPT AND INVALID OPTIONS 27150000 L R15,ADRPRNT GO PRINT 27200000 BALR R14,R15 THE INVALID OPTIONS 27250000 SPACE 2 27300000 * PRINT ERRORS ENCOUNTERED DURING OPEN 27350000 SPACE 2 27400000 MNOPNMSG TM CMSTATUS,CQOPNERR WERE ERRORS FOUND DURING OPEN 27450000 BZ MNMAPHDG NO - GO CHECK FOR MAP HEADING 27500000 SPACE 27550000 MVI CMPRTCTL,CTSPACE2 YES - SPACE 2 BEFORE MESSAGES 27600000 L R2,CMERLIST GET POINTER TO LIST 27650000 SPACE 27700000 MNOPNERR LM R0,R1,0(R2) GET ERROR INFO 27750000 L R15,ADRERROR AND PRINT 27800000 BALR R14,R15 IT OUT 27850000 SPACE 2 27900000 * PRINT MAP HEADING IF REQUIRED 27950000 SPACE 2 28000000 MNMAPHDG TM CMPRMFLG,CQMAP IS MAP SPECIFIED 28050000 BZ MNPRDONE NO - GO FINISH SYSPRINT 28100000 SPACE 28150000 L R2,CMPUTREC YES - GET PRINT BUFFER ADDRESS 28200000 LH R3,CMMAPLIN R3 HAS LENGTH OF LINE 28230000 AR R3,R2 HIGH ADDRESS 28260000 SPACE 28300000 MNMORMAP MVC 6(MAPHDLNG,R2),MAPHEAD MOVE A MAP HEADING ENTRY 28350000 LA R2,ENTRYSZ(R2) UPDATE DISPLACEMENT TO NEXT 28380000 CR R2,R3 ARE WE OVER LIMIT FOR BUFFER 28410000 BL MNMORMAP NO. INSERT ANOTHER 28440000 MVI CMPRTCTL,CTSPACE3 SPACE 3 BEFORE PRINT 28500000 L R15,ADRPRNT AND PRINT 28550000 BALR R14,R15 THE MAP HEADING 28600000 SPACE 28650000 MNPRDONE MVI CMPRTCTL,CTSPACE2 MOVE SPACE 2 TO CONTROL 28700000 L R10,CMRDCBPT PICK UP INPUT DCB POINTER 28750000 B MNCHKLIN AND GO CHECK SYSLIN 28800000 SPACE 2 28850000 TESTOP TM CMPRMFLG,0 TEST IF OPTION SPECIFIED 28900000 MOVEOPT MVC 1(0,R2),0(R6) MOVE VALID OPTIONS TO PRINT BUF 28950000 MVREJOPT MVC REJOPTLG+2(0,R2),0(R3) MOVE REJ OPTIONS TO PRINT BUF 29000000 MOVEHDNG MVC 1(0,R2),0(R2) EXECUTED CLEAR OF BUFFER 29020000 EJECT 29050000 *********************************************************************** 29100000 * * 29150000 * OPEN SYSLIN ONLY -- NOPRINT OPTION SPECIFIED * 29200000 * * 29250000 *********************************************************************** 29300000 SPACE 2 29350000 MNOPENIN OPEN MF=(E,CMIOLST1) 29400000 SPACE 29450000 MNONEBUF LA R0,121 PROVIDE ONE 29500000 BAL R14,GETCORE SYSPRINT BUFFER 29550000 ST R1,CMPUTREC SINCE SYSPRINT NOY SPECIFIED 29600000 NI CMPRMFLG,X'FF'-CQMAP INSURE MAP FLAG IS OFF 29650000 MNCHKLIN NI CMSTATUS,X'FF'-CQMSGSAV TURN OFF MESSAGE SAVE REQUEST 29700000 TM CMFLAG3,CQINCORE IS SYSLIN INCORE 29710000 BO MNGOTORL YES. SKIP PRIME 29720000 TM CMIOFLGS,CQIOERR TERMINATION ERROR OCCUR 29750000 BO MNIDEN YES. GO CLOSE OUT 29800000 TM DCBOFLGS,DCBOPEN WAS SYSLIN SUCCESSFULLY OPENED 29850000 BO MNALOCRD YES - ALLOCATE BUFFERS AND DECB'S 29900000 * 29950000 LA R0,ERIOUT1 NO - LOAD ERROR CODE 30000000 LA R1,CMLINDD ADDRESS OF DDNAME 30050000 L R15,ADRERROR ADDRESS OF ERROR ROUTINE 30100000 BALR R14,R15 GIVE ERROR 30150000 B MNIDEN AND GO CLOSE OUT 30200000 SPACE 2 30250000 MNALOCRD OI DCBOFLGS,UNLKATRB YES - SET UNLIKE ATTRIBUTES BIT 30300000 L R15,ADRBUFFR AND GO ALLOCATE 30350000 BALR R14,R15 FOR SYSLIN 30400000 TM CMSTATUS,CQABORT TERMINATION ERROR OCCURR 30450000 BNZ MNIDEN YES - GO CLOSE OUT 30500000 * 30550000 TM CMIOFLGS,CQFIXED IS THE RECORD FORMAT FIXED 30600000 BO MNOBJMOD YES - GO PRIME FOR OBJECT MODULE 30650000 * 30700000 * LOAD MODULE INPUT -- GO TO IEWLLIBR FOR PROCESSING 30750000 * 30800000 L R15,ADRLMPRC GET ENTRY POINT TO LOAD MODULE PROC 30850000 BALR R14,R15 AND GO PROCESS 30900000 B MNEOCRET LOAD MODULE IN -- GO CHECK FOR MORE 30950000 * 31000000 * OBJECT MODULE INPUT -- GO TO IEWLRELO FOR PROCESSING 31050000 * 31100000 MNOBJMOD L R15,ADRPRIME FIRST -- PRIME THE 31150000 BALR R14,R15 OBJECT MODULE BUFFERS 31200000 * 31250000 MNGOTORL EQU * 31270000 L R15,ADROMPRC THEN -- GO PROCESS 31300000 BALR R14,R15 THE OBJECT MODULE 31350000 SPACE 31400000 MNEOCRET TM CMSTATUS,CQABORT TERMINATION ERROR OCCUR 31450000 BNZ MNBITMAP YES - GO CLOSE OUT 31500000 * 31550000 * RETURN FROM PROCESSING ONE CONCATENATION OF SYSLIN ----- 31600000 * CHECK FOR ANOTHER CONCATENATION RECEIVED 31650000 * 31700000 TM CMIOFLGS,CQEOCB+CQEOFB CHECK EOC AND EOF 31750000 SPACE 31800000 BM MNALOCRD ONLY ONE - ANOTHER CONCAT 31850000 * 31900000 * ALL PRIMARY INPUT HAS BEEN LOADED --- GO TO IEWACALL TO PROCESS 31950000 * AUTO-CALL AND FINAL RESOLUTION 32000000 * 32050000 L R15,ADRACALL 32100000 BALR R14,R15 32150000 * LOADING IS COMPLETE IDENTIFY PROGRAM 32152000 * 32154000 MNIDEN L R1,CMNXTTXT ROUND UP LAST ADDRESS USED 32156000 LA R1,7(R1) TO DOUBLEWORD 32158000 N R1,DBLMASK 32160000 ST R1,CMNXTTXT 32162000 L R1,CMLOWTBL ROUND DOWN LOWEST TABLE 32164000 N R1,DBLMASK ADDRESS USED 32166000 ST R1,CMLOWTBL 32168000 TM CMFLAG3,CQIDEN IS IDENTIFICATION WANTED 32170000 BZ MNNOID NO. DON'T IDENTIFY 32172000 TM CMFLAG4,CQNOEX IS EXECUTION SCHEDULED 32174000 BO MNNOID NO. DON'T IDENTIFY 32176000 L R15,ADRCDE YES. GO CONSTRUCT CDE OR LPRB 32178000 BALR R14,R15 GO DO IT 32180000 MNNOID EQU * 32182000 * 32200000 * LOADING IS COMPLETE -- GO PROCESS THE DIAGNOSTIC MESSAGE DICTIONARY 32250000 * 32300000 MNBITMAP L R15,ADRABTMP GO TO PROCESS THE BITMAP 32350000 BALR R14,R15 32400000 LR R5,R15 SAVE THE RETURN CODE 32450000 EJECT 32500000 ******************************************************************* 32550000 * * 32600000 * ALL PROCESSING IS COMPLETE -- THE FOLLOWING WILL * 32650000 * * 32700000 * 1. WRITE THE LAST SYSPRINT BLOCK (SHORT IF NECESSARY) * 32750000 * 2. CHECK ALL UNCHECKED SYSPRINT DECB'S * 32800000 * 3. CLOSE INPUT AND OUTPUT DCB'S * 32850000 * 4. SET UP THE RETURN PARAMETER LIST * 32900000 * 5. FREE ALL STORAGE NOT USED BY THE LOADED PROGRAM * 32950000 * 6. RETURN TO THE INVOKING PROGRAM * 33000000 * * 33050000 * NOTE - REGISTER 5 MUST BE PRESERVED UNTIL RETURN TO THE INVOKING 33100000 * PROGRAM. IT CONTAINS THE RETURN CODE PASSED FROM IEWBTMAP. 33150000 * 33200000 ******************************************************************* 33250000 SPACE 3 33300000 MNPRPURG TM CMSTATUS,CQPRTOPN IS THE SYSPRINT DCB OPEN 33350000 BZ MNCLOSE NO - GO CLOSE INPUT DATA-SET 33400000 SPACE 33450000 L R10,CMWDCBPT YES - GET SYSPRINT DCB 33500000 USING IHADCB,R10 AND IDENTIFY IT 33550000 L R9,CMWDECPT GET CURRENT DECB 33600000 LA R9,0(R9) INSURE TOP BYTE IS ZERO 33650000 USING DECB,R9 AND IDENTIFY IT 33700000 SPACE 33750000 L R3,CMPUTREC COMPUTE SIZE 33800000 AH R3,DCBLRECL OF LAST 33850000 S R3,DECAREA SYSPRINT BLOCK AND 33900000 STH R3,DCBBLKSI STORE INTO DCB BLOCKSIZE 33950000 SPACE 34000000 BAL R7,WTWRITE AND WRITE THE LAST BLOCK 34050000 SPACE 34100000 MNNOTRNC LR R8,R9 SAVE POINTER TO DECB 34150000 MNNXTPRG L R9,DECDECPT GET POINTER TO NEXT DECB 34200000 BAL R7,WTCHECK AND GO CHECK IT 34250000 SPACE 34300000 MNNOCHK CR R8,R9 WAS THAT THE LAST DECB 34350000 BNE MNNXTPRG NO - GO CHECK THE NEXT 34400000 SPACE 2 34450000 MNCLOSE EQU * 34500000 LA R3,CMIOLST1 POINT TO BEGINNING OF CLOSE LIST 34501000 TM CMSTATUS,CQLIBOPN IS LIBRARY OPEN 34502000 BO MNCLS2 YES. SEE IF IT'S PASSED 34504000 TM CMFLAG3,CQPASLIN NO. IS LIN PASSED 34506000 BZ MNCLS3 NO. WE NEED TO CLOSE IT 34508000 B MNCLS35 CHECK SYSPRINT 34515000 MNCLS2 TM CMFLAG3,CQPASLIB WAS LIB PASSED 34522000 BZ MNCLS3 NO. 34524000 L R10,CMRDCBPT YES. GET LIB DCB 34526000 MVC DCBSYNAD+1(3),CMLIBSYN+1 RESTORE EXIT ADDRESSES 34528000 MVC DCBEODAD+1(3),CMLIBEOD+1 RESTORE EXIT ADDRESSES 34530000 MVC DCBEXLST+1(3),CMLIBEXL+1 RESTORE EXIT ADDRESSES 34532000 B MNCLS35 DON'T CLOSE IT 34534000 MNCLS3 EQU * 34536000 SPACE 2 34550000 L R10,CMRDCBPT PICK UP INPUT DCB POINTER 34600000 BAL R8,ENTCLOSE STORE INTO CLOSE LIST 34660000 SPACE 34720000 MNCLS35 TM CMSTATUS,CQPRTDCB IS SYSPRINT OPEN 34780000 BZ MNCLS4 BRANCH TO CHECK SYSTERM 34840000 SPACE 34900000 L R10,CMWDCBPT YES - PICK UP OUTPUT DCB POINTER 34950000 BAL R8,ENTCLOSE STORE INTO CLOSE LIST 34960000 MNCLS4 TM CMFLAG4,CQTRMOPN IS SYSTERM OPEN 34970000 BNO MNCHKCLS NO. BRANCH 34980000 L R10,CMTDCBPT YES. CLOSE IT 34990000 BAL R8,ENTCLOSE STORE INTO CLOSE LIST 35000000 MNCHKCLS LA R1,CMIOLST1 35010000 CR R1,R3 DO WE NEED TO ISSUE CLOSE 35020000 BE MNCLS5 NO. 35030000 LA R1,4 YES. BACK TO LAST ENTRY 35040000 SR R3,R1 35050000 OI 0(R3),X'80' FLAG LAST ENTRY 35060000 SPACE 2 35150000 MNNOPRNT CLOSE MF=(E,CMIOLST1) CLOSE OUT DATA SETS 35200000 MNCLS5 EQU * 35241000 SPACE 35250000 L R1,CMMAINPT GET 1ST ADDR USED 35258000 LR R2,R1 SAVE FOR RETURN 35266000 L R8,CMXLCHN GET FIRST EXTENT ADDR M3177 35274021 * BY COMPILER 35282000 LTR R8,R8 WERE THERE ANY? 35290000 BZ MNCLSG NO 35298000 L R6,4(R8) 35314000 ST R6,8(R1) STORE FOR LATER FREEMAIN 35322000 L R6,8(R8) GET 1ST EXTENT LENGTH 35330000 ST R6,12(R1) STORE FOR LATER FREEMAIN 35338000 TM CMFLAG4,CQNOEX ARE WE GOING TO EXECUTE? 35346000 BNO MNXOK YES. 35354000 TM CMFLAG4,CQIDONE NO. HAS PGM BEEN IDENTIFIED? 35362000 BNO MNNOX NO. GO FREEMAIN EXTENTS 35370000 MNLDDT LOAD EPLOC=CMPGMNM YES. DE-IDENTIFY W/LOAD & DELETE 35378000 DELETE EPLOC=CMPGMNM 35386000 B MNNOR1 35394000 MNCLSG EQU * 35402000 TM CMFLAG4,CQNOEX IS PGM EXECUTABLE? 35410000 BNO MNXOK YES. 35418000 TM CMFLAG4,CQIDONE NO. HAS PGM BEEN IDENTIFIED? 35426000 BO MNLDDT YES. GO TO LOAD AND DELETE 35434000 MNIDCHK TM CMFLAG3,CQIDEN ENTERED THRU IEWLOAD? 35442000 BO MNMARK YES. FREEMAIN EVERYTHING 35450000 B MNLOADR NO. PROCESS FOR IEWLOADR 35458000 MNXOK EQU * 35466000 TM CMFLAG3,CQIDEN ENTERED THRU IEWLOAD? 35474000 BO MNNOR1 YES. 35482000 MNLOADR ST R1,0(R1) NO. ENTERRED THRU IEWLOADR 35490000 L R3,CMNXTTXT PICK UP LENGTH 35498000 SR R3,R1 GET TRUE LENGTH 35506000 ST R3,4(R1) AND STROE IT 35514000 B MNNOR1 35522000 MNNOX EQU * 35530000 L R0,12(R1) PICK UP 1ST EXTENT LENGTH 35538000 L R1,8(R1) PICK UP 1ST EXTENT ADDR 35546000 FREEMAIN R,LV=(0),A=(1) FREE 1ST EXTENT 35554000 LR R1,R2 RESTORE REG. 1 35562000 B MNIDCHK 35570000 MNNOR1 L R1,CMNXTTXT HI ADDRESS FOR FREEMAIN 35580000 MNMARK L R8,CMEPADDR GET ENTRY POINT ADDRESS 35610000 L R13,4(R13) PICK UP SAVE AREA POINTER 35750000 L R0,CMHITBL GET HIGHEST CORE ADDRESS 35800000 SR R0,R1 AND CALCULATE FREEMAIN SIZE 35850000 * FREEING TABLE AND BUFFER STORAGE. 35860000 * ALSO PROGRAM STORAGE IF RETURN CODE GREATER THAN 4 35870000 BZ MNNOFREE FREEMAIN SIZE ZERO -- NO FREE 35900000 SPACE 35950000 FREEMAIN R,LV=(0),A=(1) FREE ALL STORAGE NOT USED BY PRO 36000000 SPACE 36050000 MNNOFREE LR R0,R8 MOVE EP ADDRESS TO REG 0 36100000 LR R1,R2 MOVE RETURN LIST ADDRESS TO R1 36150000 LR R15,R5 PUT RETURN CODE INTO R15 36200000 SPACE 36250000 * RETURN TO INVOKING PROGRAM 36300000 SPACE 36350000 L R14,12(0,13) LOAD RETURN REGISTER 36400000 LM R2,R12,28(13) LOAD REGISTERS EXCEPT 15-0-1 36450000 MVI 12(13),X'FF' SET RETURN INDICATION 36500000 BR R14 AND RETURN 36550000 * 36555000 * STORES DCB POINTER INTO CLOSE LIST. R3 POINTS TO LIST ENTRY 36560000 * 36565000 ENTCLOSE O R10,CLOSE OR IN OPTION BYTE 36570000 ST R10,0(R3) STORE INTO CLOSE LIST 36575000 NI 0(R3),X'7F' CLEAR LIST DELIMITER 36580000 LA R3,4(R3) UP TO NEXT ENTRY 36585000 BR R8 36590000 SPACE 3 36600000 EJECT 36650000 ******************************************************************* 36700000 * * 36750000 * OPEN SYSLIB -- THIS ROUTINE WILL CLOSE 'SYSLIN', MOVE THE * 36800000 * 'SYSLIB' DDNAME INTO THE DCB AND RE-OPEN IT FOR PARTITIONED * 36850000 * ORGANIZATION. IF IT OPENS SUCCESSFULLY, BUFFERS ARE ALLOCATED * 36900000 * AND THE 'SYSLIB OPEN' BIT IN THE COMMUNICATIONS AREA IS SET ON.* 36950000 * IF THE 'SYSLIB' DATA-SET HAS NOT BEEN ALLOCATED (DCB DOES NOT * 37000000 * OPEN), A DIRECT RETURN IS MADE. * 37050000 * * 37100000 ******************************************************************* 37150000 SPACE 3 37200000 ENTRY IEWOPNLB 37250000 USING IHADCB,R10 37300000 IEWOPNLB SAVE (14,12),,* SAVE CALLERS REGISTERS 37350000 USING IEWOPNLB,R15 IDENTIFY ENTRY POINT BASE 37400000 L R12,IOCABASE LOAD CSECT BASE 37450000 DROP R15 DROP ENTRY POINT BASE 37500000 USING IEWLIOCA,R12 AND IDENTIFY CSECT BASE 37550000 L R4,IOCABSE2 LOAD AND IDENTIFY 37560000 USING IEWLIOCA+4096,R4 SECOND BASE REGISTER 37570000 SPACE 37600000 L R13,8(R13) GET NEXT SAVE AREA POINTER 37650000 * 37700000 L R10,CMRDCBPT GET POINTER TO INPUT DCB 37750000 TM CMFLAG3,CQPASLIN WAS SYSLIN PASSED 37760000 BO LB1 YES. SKIP CLOSE AND CHECK LIB 37770000 O R10,CLOSE OR CLOSE OPTIONS INTO IT 37800000 ST R10,CMIOLST1 AND STORE INTO LIST 37850000 SPACE 37900000 CLOSE MF=(E,CMIOLST1) CLOSE PRIMARY INPUT DCB 37950000 LB1 TM CMFLAG3,CQPASLIB WAS SYSLIB PASSED 37954000 BO LB2 YES. ASSUME IT'S OPEN 37958000 TM CMFLAG3,CQPASLIN DO WE HAVE TO ALLOCATE 37962000 BZ LB4 NO. USE SYSLIN DCB 37966000 LA R0,DCBSIZE ALLOCATE DCB 37970000 BAL R14,GETCORE 37974000 ST R1,CMRDCBPT 37978000 LR R10,R1 37982000 MVC IHADCB(DCBSIZE),MODELDCB 37986000 MVC DCBMACR(2),MACRREAD 37990000 LB4 EQU * 37994000 SPACE 38000000 MVC DCBDDNAM(8),CMLIBDD MOVE SYSLIB DDNAME INTO DCB 38050000 MVC DCBDSORG(2),DSORGPO SET DCB PARTITIONED 38100000 SR R2,R2 ZERO OUT 38150000 STH R2,DCBLRECL LRECL AND 38200000 STH R2,DCBBLKSI BLKSIZE 38250000 SPACE 38300000 LA R10,0(R10) ZERO FLAG BYTE IN DCB POINTER 38350000 O R10,OPENIN OR IN OPTION BYTE 38400000 ST R10,CMIOLST1 AND STORE INTO LIST 38450000 SPACE 38500000 OPEN MF=(E,CMIOLST1) OPEN DCB FOR AUTO-CALL LIBRARY 38550000 SPACE 38600000 TM CMIOFLGS,CQIOERR TEST IF RECFM=V FOUND IN OPEN 38650000 BO IOABORT YES - ABORT LOADING 38700000 LB5 TM DCBOFLGS,DCBOPEN WAS THE DCB OPEN 38750000 BZ LBRETURN NO - REUTRN 38800000 SPACE 38850000 OI CMSTATUS,CQLIBOPN YES - SET LIBRARY OPEN BIT 38900000 L R15,ADRBUFFR AND GO 38950000 BALR R14,R15 ALLOCATE BUFFERS 39000000 SPACE 39050000 LBRETURN L R13,4(R13) PICK UP PREVIOUS SAVE AREA 39100000 RETURN (14,12),T AND RETURN 39150000 LB2 L R10,CMLIBDCB GET PASSED DCB 39152000 ST R10,CMRDCBPT 39154000 MVC CMLIBSYN+1(3),DCBSYNAD+1 SAVE EXIT ROUTINE ADDRESSES 39156000 MVC CMLIBEOD+1(3),DCBEODAD+1 SAVE EXIT ROUTINE ADDRESSES 39158000 MVC CMLIBEXL+1(3),DCBEXLST+1 SAVE EXIT ROUTINE ADDRESSES 39160000 XC DCBSYNAD+1(3),DCBSYNAD+1 USE LOADER SYNAD ROUTINE 39162000 LA R7,SYNAD 39164000 L R6,DCBSYNAD 39166000 OR R7,R6 39168000 ST R7,DCBSYNAD 39170000 XC DCBEODAD+1(3),DCBEODAD+1 39172000 LA R7,EODAD 39174000 L R6,DCBEODAD 39176000 OR R7,R6 39178000 ST R7,DCBEODAD 39180000 XC DCBEXLST+1(3),DCBEXLST+1 USE LOADER DCB EXIT 39182000 LA R7,DCBEXIT 39184000 L R6,DCBEXLST 39186000 OR R7,R6 39188000 ST R7,DCBEXLST 39190000 B LB5 39192000 EJECT 39200000 *********************************************************************** 39250000 * * 39300000 * DECB AND BUFFER DEALLOCATION - ALLOCATION ROUTINE 39350000 * UPON ENTRY -- R10 POINTS TO THE DCB FOR WHICH BUFFERS ARE 39400000 * TO BE ALLOCATED 39450000 * * 39500000 *********************************************************************** 39550000 SPACE 3 39600000 USING DECB,R9 39650000 ENTRY IEWBUFFR 39700000 SPACE 2 39750000 IEWBUFFR SAVE (14,12) SAVE REGISTERS 39800000 USING IEWBUFFR,R15 IDENTIFY EP BASE 39850000 L R12,IOCABASE LOAD CSECT BASE 39900000 DROP R15 DROP EP BASE 39950000 USING IEWLIOCA,R12 AND IDENTIFY CSECT BASE 40000000 L R4,IOCABSE2 LOAD AND IDENTIFY 40010000 USING IEWLIOCA+4096,R4 SECOND BASE REGISTER 40020000 L R13,8(R13) PICK UP NEXT SAVE AREA 40050000 * 40100000 C R10,CMWDCBPT IS THIS ALLOCATION FOR SYSPRINT 40150000 BE ALOCPRNT YES - NO PREVIOUS BUFFERS ALLOC 40200000 * 40250000 TM CMIOFLGS,CQFIXED+CQUNDEF IS THERE A PREV ALLOCATION 40300000 BZ CHKFORMT NO - BYPASS DEALLOCATION 40350000 SPACE 40400000 L R9,CMRDECPT PICK UP POINTER TO FIRST DECB 40450000 TM CMIOFLGS,CQUNDEF WAS THE PREV ALLOC FOR UNDEFINED 40500000 BZ DEALFIXD NO - DEALLOCATE FIXED 40550000 * 40600000 TM DCBRECFM,UNDEFINE IS THIS ALLOCATION FOR UNDEFINED 40650000 BO UNDFINSH YES - LEAVE ALLOCATION THE SAME 40700000 * 40750000 * THE PREVIOUS ALLOCATION WAS FOR UNDEFINED AND THIS ONE IS FOR 40800000 * FIXED -- DEALLOCATE THE UNDEFINED BUFFERS BEFORE ALLOCATION FOR 40850000 * THE FIXED FORMAT 40900000 * 40950000 L R1,CMGETREC PICK UP POINTER TO THE RLD BUFFER 41000000 LA R0,RLDSIZE PUT SIZE INTO R0 41050000 BAL R14,FREECORE AND FREE THE BUFFER 41100000 * 41150000 L R1,DECDECPT PICK UP POINTER TO SECOND DECB 41200000 LA R0,DECBSIZE PUT DECB SIZE INTO R0 41250000 BAL R14,FREECORE AND FREE THE SECOND DECB 41300000 * 41350000 LR R1,R9 POINTER TO FIRST DECB TO PARM REG 41400000 LA R0,DECBSIZE SIZE OF DECB 41450000 BAL R14,FREECORE FREE THE FIRST DECB 41500000 * 41550000 B ALFIXSET GO ALLOCATE FOR THIS CONCATENATION 41600000 * 41650000 * DEALLOCATE A LIST OF FIXED SIZE BUFFERS AND THEIR ASSOCIATED DECB'S 41700000 * 41750000 DEALFIXD LR R6,R9 LIMIT IS POINTER TO FIRST DECB 41800000 * 41850000 DEALMORE L R7,DECDECPT GET THE POINTER TO NEXT DECB 41900000 L R1,DECAREA BUFFER POINTER FOR THIS DECB 41950000 LH R0,CMBLKSIZ SIZE OF BUFFER 42000000 BAL R14,FREECORE FREE THE BUFFER 42050000 * 42100000 LR R1,R9 MOVE THE DECB POINTER 42150000 LA R0,DECBSIZE SIZE OF DECB 42200000 BAL R14,FREECORE FREE THE DECB 42250000 * 42300000 LR R9,R7 POINT TO NEXT DECB 42350000 CR R9,R6 IS IT BACK AROUND TO THE FIRST 42400000 BNE DEALMORE NO - GO FREE THIS COMBINATION 42450000 * 42500000 CHKFORMT TM DCBRECFM,UNDEFINE IS THIS ALLOCATION FOR UNDEFINED 42550000 BO ALOCUNDF YES - GO ALLOCATE FOR IT 42600000 * 42650000 * ALLOCATE A LIST OF FIXED SIZE BUFFERS AND THEIR ASSOCIATED DECB'S 42700000 * THE SIZE OF THE BUFFERS IS FOUND IN 'DCBBLKSI' 42750000 * THE NUMBER OF BUFFERS IS FOUND IN 'DCBNCP' 42800000 * 42850000 ALFIXSET EQU * 42900000 ALOCPRNT SR R7,R7 GET THE NUMBER 42950000 IC R7,DCBNCP PICK UP NUMBER OF BUFFERS 43000000 SPACE 43050000 ALOCFIXD BAL R15,GETDECB GET A DECB 43100000 LR R6,R9 SAVE POINTER TO IT 43150000 B FIXDSTRT AND GO ALLOCATE THE LIST 43200000 SPACE 43250000 FIXDMORE LR R8,R9 SAVE POINTER TO THIS DECB 43300000 BAL R15,GETDECB AND GET ANOTHER 43350000 SPACE 43400000 FIXDSTRT LH R0,DCBBLKSI GET SIZE OF A BUFFER 43450000 BAL R14,GETCORE AND GET A BUFFER FOR THE DECB 43500000 * 43550000 ST R1,DECAREA STORE BUFFER ADDRESS INTO DECB 43600000 ST R8,DECDECPT CHAIN THIS DECB TO THE LAST 43650000 BCT R7,FIXDMORE AND GO GET ANOTHER IF NEEDED 43700000 * 43750000 * ALL BUFFERS AND DECB'S HAVE BEEN ALLOCATED 43800000 * 43850000 ST R9,DECDECPT-DECB(R6) CHAIN LAST DECB TO THE FIRST 43900000 * 43950000 C R10,CMWDCBPT IS THIS ALLOCATION FOR SYSPRINT 44000000 BNE FIXDIND NO - SET INPUT INDICATORS 44050000 * 44100000 ST R9,CMWDECPT YES - STORE POINTER FOR OUTPUT 44150000 B ALOCRETN AND RETURN 44200000 * 44250000 FIXDIND MVC CMBLKSIZ(2),DCBBLKSI SAVE BLKSIZE FOR NEXT CONCAT 44300000 MVI CMIOFLGS,CQFIXED TURN OFF ALL I/O FLAGS EXCEPT FIXED 44350000 B INPFINSH AND GO FINISH UP 44400000 * 44450000 * ALLOCATE 2 DECB'S AND 1 RLD BUFFER FOR UNDEFINED FORMAT 44500000 * THE FIRST DECB IS FOR THE RLD RECORDS AND IS POINTED TO 44550000 * BY 'CMRDECPT' 44600000 * THE RLD BUFFER POINTER IS STORED INTO THE DECB AND 'CMGETREC' 44650000 * THE SECOND DECB IS CHAINED TO THE RLD DECB 44700000 * THE SECOND DECB HAS NO BUFFER ALLOCATED FOR IT -- IT IS USED 44750000 * FOR READING TEXT DIRECTLY TO THE LOCATION WHERE IT WILL REMAIN 44800000 * 44850000 ALOCUNDF BAL R15,GETDECB GET A DECB 44900000 LR R7,R9 MOVE POINTER 44950000 BAL R15,GETDECB GET ANOTHER 45000000 ST R7,DECDECPT STORE POINTER TO LAST INTO IT 45050000 ST R9,DECDECPT-DECB(R7) STORE POINTER TO THIS INTO LAST 45100000 SPACE 45150000 LA R0,RLDSIZE GET A BUFFER 45200000 STH R0,DECLNGTH STORE SIZE INTO DECB 45250000 BAL R14,GETCORE FOR RLD RECORDS 45300000 ST R1,DECAREA STORE BUFFER POINTER IN DECB 45350000 ST R1,CMGETREC STORE BUFFER POINTER IN COMMON AREA 45400000 * 45450000 UNDFINSH MVI CMIOFLGS,CQUNDEF CLEAR I/O FLAGS EXCEPT UNDEFINED 45500000 * 45550000 INPFINSH ST R9,CMRDECPT STORE POINTER TO DECB CHAIN 45600000 ALOCRETN L R13,4(R13) PICK UP PREVIOUS SAVE AREA POINTER 45650000 RETURN (14,12),T AND RETURN 45700000 SPACE 3 45750000 GETDECB LA R0,DECBSIZE SIZE OF A DECB 45800000 BAL R14,GETCORE GET STORAGE FOR IT 45850000 LR R9,R1 MOVE POINTER TO USING REG 45900000 XC DECB(DECBSIZE-4),DECB CLEAR IT OUT 45950000 ST R10,DECDCBAD STORE THE DCB POINTER 46000000 BR R15 AND RETURN 46050000 EJECT 46100000 *********************************************************************** 46150000 * * 46200000 * ROUTINE TO ALLOCATE STORAGE FROM A LIST OF FREE AREAS POINTED TO 46250000 * BY 'CMFRECOR' -- AND PRIME (NEVER ALLOCATED) CORE IF A PREVIOUSLY 46300000 * ALLOCATED AREA IS NOT AVAILABLE 46350000 * 46400000 * UPON ENTRY -- REGISTER 0 CONTAINS THE SIZE REQUESTED 46450000 * 46500000 * UPON RETURN -- REGISTER 1 POINTS TO THE ALLOCATED AREA 46550000 * 46600000 * THIS ROUTINE DOES NOT SAVE AND RESTORE REGISTERS --- 46650000 * REGISTERS 2 THROUGH 5 ARE USED AND THEREFOR ARE VOLITILE 46700000 * 46750000 *********************************************************************** 46800000 SPACE 2 46850000 GETCORE LA R2,CMFRECOR PICK UP POINTER TO FREE CORE CHAIN 46900000 SPACE 46950000 LR R3,R0 ROUND 47000000 LA R0,7(R3) SIZE UP TO 47050000 N R0,DBLMASK DOUBLE WORD 47100000 SPACE 47150000 GCAGAIN L R1,0(R2) GET POINTER TO NEXT AREA 47200000 LTR R1,R1 IS THERE A NEXT AREA 47250000 BZ GETPRIME NO - GO ALLOCATE PRIME CORE 47300000 * 47350000 L R5,4(R1) YES - GET SIZE OF THE AREA 47400000 SR R5,R0 SUBTRACT REQUEST SIZE FROM THIS SIZE 47450000 BZ GCGIVEL IF EQUAL -- GIVE THE ENTIRE AREA 47500000 BP GCSUBDIV IF THIS SIZE LARGER - GIVE PORTION 47550000 LR R2,R1 NOT ENOUGH ---- 47600000 B GCAGAIN TRY NEXT AREA 47650000 * 47700000 * 47750000 GCGIVEL L R5,0(R1) PICK UP POINTER TO NEXT AREA 47800000 ST R5,0(R2) AND CHAIN IT TO LAST AREA 47850000 BR R14 RETURN WITH AREA 47900000 * 47950000 GCSUBDIV ST R5,4(R1) STORE NEW SIZE AS DIFFERENCE 48000000 AR R1,R5 ADD DIFFERENCE TO POINTER 48050000 BR R14 AND RETURN 48100000 * 48150000 * 48200000 GETPRIME L R1,CMLOWTBL GET LOWEST ADDRESS USED SO FAR 48250000 SR R1,R0 SUBTRACT OFF REQUESTED SIZE 48300000 ST R1,CMLOWTBL AND STORE AS NEW LOW ADDRESS 48350000 C R1,CMLSTTXT IS IT LOWER THAN THE HIGHEST TEXT 48400000 BCR 10,R14 NO -- RETURN GIVING AREA 48450000 * 48500000 * TABLE OVERFLOW -- GIVE ERROR MESSAGE AND EXIT 48550000 * 48600000 LA R0,ERSIZE2 LOAD MESSAGE NUMBER 48650000 L R15,ADRERROR ENTRY POINT TO ERROR LIST 48700000 BR R15 AND ABORT LOADING 48750000 EJECT 48800000 *********************************************************************** 48850000 * * 48900000 * ROUTINE TO RETURN STORAGE TO A FREE LIST POINTED TO BY 'CMFRECOR' 48950000 * 49000000 * UPON ENTRY -- REGISTER 1 POINTS TO THE AREA TO BE FREED 49050000 * REGISTER 0 CONTAINS THE SIZE OF THE AREA TO BE FREED 49100000 * 49150000 * THIS ROUTINE DOES NOT SAVE AND RESTORE REGISTERS --- 49200000 * REGISTERS 1 THROUGH 4 ARE USED AND THEREFOR ARE VOLITILE 49250000 * 49300000 *********************************************************************** 49350000 SPACE 2 49400000 FREECORE LA R1,0(R1) INSURE TOP BYTE OF POINTER IS ZERO 49450000 LA R2,CMFRECOR GET POINTER TO FREE CORE CHAIN 49500000 SPACE 49550000 LR R3,R0 ROUND 49600000 LA R0,7(R3) SIZE UP TO 49650000 N R0,DBLMASK DOUBLE WORD 49700000 SPACE 49750000 FCAGAIN L R3,0(R2) GET POINTER TO FREE AREA 49800000 LTR R3,R3 IS THERE REALLY ONE THERE 49850000 BZ FCSTASH NO - GO SAVE THIS ONE BY ITSELF 49900000 * 49950000 LR R5,R1 DOES THE ADDRESS PLUS SIZE OF 50000000 AR R5,R0 THE RETURNING AREA EQUAL 50050000 CR R5,R3 THE START OF THIS AREA 50100000 BE FCBELOW YES - COMBINE THE TWO INTO ONE BIG ONE 50150000 * 50200000 L R5,4(R3) DOES THE ADDRESS PLUS SIZE OF 50250000 AR R5,R3 THIS ONE EQUAL THE START 50300000 CR R5,R1 OF THE RETURNING AREA 50350000 BE FCABOVE YES -- COMBINE THESE TWO TOGETHER 50400000 * 50450000 LR R2,R3 THE RETURNING BLOCK IS NOT CONTIGUOUS 50500000 B FCAGAIN WITH THIS ONE -- GO CHECK THE NEXT 50550000 * 50600000 * 50650000 FCABOVE LR R1,R3 MAKE SUBJECT AREA EQ THIS ONE 50700000 FCBELOW A R0,4(R3) ADD IT'S SIZE TO SUBJECT SIZE 50750000 L R5,0(R3) TAKE IT OUT 50800000 ST R5,0(R2) OF THE CHAIN 50850000 B FCAGAIN AND GO TRY TO MERGE THIS ONE 50900000 * 50950000 * 51000000 FCSTASH ST R1,0(R2) PUT THE BLOCK ON THE END OF THE LIST 51050000 ST R3,0(R1) ZERO IT'S POINTER FIELD 51100000 ST R0,4(R1) STORE IT'S SIZE 51150000 BR R14 AND RETURN 51200000 EJECT 51250000 *********************************************************************** 51300000 * * 51350000 * OBJECT MODULE BUFFER PRIME ROUTINE 51400000 * 51450000 *********************************************************************** 51500000 SPACE 2 51550000 ENTRY IEWPRIME 51600000 SPACE 2 51650000 IEWPRIME SAVE (14,12),,* SAVE CALLERS REGISTERS 51700000 USING IEWPRIME,R15 IDENTIFY ENTRY POINT BASE 51750000 L R12,IOCABASE LOAD CSECT BASE 51800000 DROP R15 DROP ENTRY POINT BASE 51850000 USING IEWLIOCA,R12 AND IDENTIFY CSECT BASE 51900000 L R4,IOCABSE2 LOAD AND IDENTIFY 51910000 USING IEWLIOCA+4096,R4 SECOND BASE REGISTER 51920000 SPACE 2 51950000 L R13,8(R13) GET POINTER TO NEXT SAVE AREA 52000000 L R9,CMRDECPT GET POINTER TO INPUT DECB CHAIN 52050000 USING DECB,R9 AND IDENTIFY IT 52100000 SPACE 52150000 LR R8,R9 SET READ LIMIT TO THIS DECB 52200000 L R9,DECDECPT AND GET POINTER TO NEXT DECB 52250000 BAL R7,RDREAD READ ALL INTERVENING DECB'S 52300000 SPACE 52350000 LR R9,R8 GET POINTER TO DECB NOT READ 52400000 L R6,DECAREA LOAD IT'S BUFFER POINTER 52450000 ST R6,CMGETREC AND STORE AS LAST RECORD ADDRESS 52500000 SR R7,R7 SET LENGTH OF READ 52550000 STH R7,DECLNGTH TO ZERO (NO DATA) 52600000 ST R9,CMRDECPT STORE THIS DECB AS CURRENT 52650000 SPACE 2 52700000 L R13,4(R13) LOAD POINTER TO CALLERS SAVE AREA 52750000 RETURN (14,12),T AND RETURN 52800000 EJECT 52850000 *********************************************************************** 52900000 * 52950000 * READ ROUTINE FOR THE LOADER --- ALL REQUESTS FOR DATA IN THE 53000000 * LOADER ARE MADE THROUGH THIS ROUTINE. 53050000 * 53100000 * FOR READING OBJECT MODULE INPUT --- 53150000 * NO PARAMETERS ARE PASSED 53200000 * THE ADDRESS OF THE NEW BUFFER IS RETURNED IN 'CMGETREC' 53250000 * 53300000 * FOR READING LOAD MODULE INPUT --- 53350000 * THREE OPTIONS EXIST 53400000 * 1 - (REGISTER 0 IS ZERO) - READ AN RLD RECORD 53450000 * 2 - (REGISTER 0 IS POSITIVE) - READ A TEXT RECORD 53500000 * REGISTER 0 CONTAINS THE LENGTH TO BE READ 53550000 * REGISTER 1 CONTAINS THE ADDRESS TO READ THE TEXT 53600000 * 3 - (REGISTER 0 IS NEGATIVE) - READ A TEXT AND RLD RECORD 53650000 * REGISTER 0 CONTAINS THE COMPLEMENT OF LENGTH OF TEXT * 53700000 * REGISTER 1 CONTAINS THE ADDRESS TO READ THE TEXT 53750000 * 53800000 * 53850000 * REGISTERS USED FOR IMPLIED ADDRESSING (USING STATEMENTS) 53900000 * 53950000 * REGISTER 12 - PROGRAM BASE 54000000 * REGISTER 11 - LOADER COMMUNICATION AREA 54050000 * REGISTER 10 - DCB ADDRESS (DATA CONTROL BLOCK) 54100000 * REGISTER 9 - DECB ADDRESS (DATA EVENT CONTROL BLOCK) 54150000 * 54200000 *********************************************************************** 54250000 SPACE 2 54300000 ENTRY IEWLREAD 54350000 USING IHADCB,R10 54400000 USING DECB,R9 54450000 * 54500000 * 54550000 IEWLREAD SAVE (14,12),,* SAVE CALLERS REGISTERS 54600000 USING IEWLREAD,R15 IDENTIFY ENTRY POINT ADDRESS 54650000 L R12,IOCABASE LOAD CSECT BASE 54700000 DROP R15 DROP ENTRY POINT BASE 54750000 USING IEWLIOCA,R12 IDENTIFY CSECT BASE 54800000 L R4,IOCABSE2 LOAD AND IDENTIFY 54810000 USING IEWLIOCA+4096,R4 SECOND BASE REGISTER 54820000 L R13,8(R13) PICK UP NEXT SAVE AREA 54850000 * 54900000 L R10,CMRDCBPT LOAD BASE FOR DCB 54950000 L R9,CMRDECPT AND DECB 55000000 TM CMFLAG3,CQINCORE ARE WE READING INCORE DATA SET 55010000 BO RDINCORE YES. 55020000 * 55050000 TM CMIOFLGS,CQRECFM IS THIS A FIXED OR UNDEFINED READ 55100000 BO RDUNDEFN IT'S UNDEFINED 55150000 * 55200000 * AN OBJECT MODULE IS BEING PROCESSED -- READ FIXED RECORD FORMAT 55250000 * 55300000 L R2,CMGETREC GET POINTER TO LAST RECORD 55350000 LH R3,DCBLRECL GET LOGICAL RECORD SIZE 55400000 AR R2,R3 COMPUTE NEW RECORD ADDRESS 55450000 AR R3,R2 ADD RECORD SIZE AND ADDRESS 55500000 S R3,DECAREA SUBTRACT OFF BUFFER BASE 55550000 CH R3,DECLNGTH WILL THIS RECORD GO OVER END OF BLK 55600000 BNH RDFIXFIN NO - GIVE THIS RECORD AND RETURN 55650000 * 55700000 * END OF BLOCK HAS BEEN REACHED -- READ ANOTHER 55750000 * 55800000 L R8,DECDECPT SET READ LIMIT TO NEXT DECB 55850000 BAL R7,RDREAD AND GO READ THE NEXT BLOCK 55900000 * 55950000 LR R9,R8 MOVE NEXT DECB TO CURRENT 56000000 BAL R7,RDCHECK AND CHECK IT FOR COMPLETION 56050000 * 56100000 ST R9,CMRDECPT STORE IT AS THE CURRENT DECB 56150000 L R8,DECIOBPT GET THE IOB ADDRESS FROM THE DECB 56200000 LH R5,DCBBLKSI GET BLKSIZE FROM THE DCB 56250000 SH R5,14(R8) SUBTRACT OFF RESIDUAL COUNT 56300000 STH R5,DECLNGTH AND STORE INTO THE DECB 56350000 * 56400000 L R2,DECAREA PICK UP BUFFER ADDRESS FROM DECB 56450000 * 56500000 RDFIXFIN ST R2,CMGETREC STORE NEW RECORD POINTER INTO COMMUN 56550000 B RDRETURN AND EXIT 56600000 * 56601000 * INCORE DATA SET -- ONE BLOCK ASSUMED 56602000 * 56603000 RDINCORE L R2,CMGETREC GET ADR OF LAST RECORD 56604000 TM DCBRECFM,VARIABLE IS THIS VARIABLE FORMAT 56605000 BNO FIXFORM NO, GOTO PROCESS FIXED FROMAT 56606000 * VARIABLE LENGTH RECORDS 56607000 LTR R2,R2 WAS THERE A LAST RECORD 56608000 BNZ VARINC1 YES 56609000 L R2,DCBRELAD NO, PICK UP ADDRESS 56610000 LA R2,8(R2) SKIPCNTRL WDS-1ST TIME ONLY 56611000 B RDFIXFIN 56612000 VARINC1 LA R3,4 MOVE BACK TO 56613000 SR R2,R3 GET CONTROL WORD WITH LENGTH 56614000 AH R2,0(R2) GET ADDRESS OF NEW RECORD 56615000 LA R2,3(R2) ROUND UP 56616000 N R2,FULMSK TO FULLWORD 56617000 LR R3,R2 56618000 S R3,DCBRELAD SUBTRACT BEGINNING OF DATA SET 56619000 CH R3,DCBBLKSI ARE WE DONE 56620000 BL VARINC2 NO,SEND BACK THIS RECORD 56621000 COMMON OI CMIOFLGS,CQEOFB+CQEOCB THRU WITH SYSLIN 56622000 NI CMFLAG3,X'FF'-CQINCORE 56623000 B RDRETURN 56624000 VARINC2 LA R2,4(R2) SKIP CONTRL WRD-NOT 1ST TIME 56625000 B RDFIXFIN 56626000 * FIXED LENGTH RECORDS 56627000 FIXFORM LTR R2,R2 WAS THERE A LAST RECORD 56628000 BNZ FIXINC1 56629000 L R2,DCBRELAD NO, PICK UP ADDRESS 56630000 B RDFIXFIN 56631000 FIXINC1 LH R3,DCBLRECL GET RECORD LENGTH 56632000 AR R2,R3 GET ADDRESS OF NEW RECORD 56633000 LR R3,R2 56634000 S R3,DCBRELAD SUBTRACT BEGINNING OF DATA SET 56635000 CH R3,DCBBLKSI ARE WE DONE 56636000 BL RDFIXFIN NO,SEND THIS RECORD BACK 56637000 B COMMON THRU WITH SYSLIN 56638000 * 56650000 * 56700000 * A LOAD MODULE IS BEING PROCESSED -- TEST FOR TYPE OF READ REQUIRED 56750000 * 56800000 RDUNDEFN LTR R0,R0 56850000 BZ RDRLD ZERO - READ RLD/CONTROL RECORD 56900000 BP RDTXT POSITIVE - READ TEXT 56950000 * 57000000 * REGISTER 0 IS NEGATIVE --- READ TEXT AND RLD/CONTROL 57050000 * 57100000 LPR R0,R0 COMPLEMENT THE SIZE 57150000 L R9,DECDECPT PICK UP TXT DECB POINTER 57200000 STH R0,DECLNGTH STORE TXT SIZE INTO DECB 57250000 ST R1,DECAREA STORE TXT ADDRESS INTO DECB 57300000 LR R8,R9 SET READ LIMIT TO THIS DECB 57350000 BAL R7,RDREAD AND GO READ TXT/RLD RECORDS 57400000 * 57450000 * THE TEXT DECB MUST BE CHECKED FIRST 57500000 * 57550000 LR R9,R8 GET TEXT DECB POINTER 57600000 BAL R7,RDCHECK AND CHECK IT FOR COMPLETION 57650000 L R9,DECDECPT PICK UP POINTER TO NEXT DECB 57700000 TM CMIOFLGS,CQEOCB DID END OF CONCATENATION OCCUR 57750000 BZ RDLSTCHK NO - GO CHECK THE OTHER DECB 57800000 * 57850000 OI CMIOFLGS,CQEOFSB YES - SET BIT TO INDICATE NO REC 57900000 B RDRETURN AND RETURN 57950000 * 58000000 * 58050000 * REGISTER 0 IS POSITIVE --- READ A TEXT RECORD 58100000 * 58150000 RDTXT L R9,DECDECPT GET POINTER TO TEXT DECB 58200000 STH R0,DECLNGTH STORE TXT SIZE INTO DECB 58250000 ST R1,DECAREA STORE TXT ADDRESS INTO DECB 58300000 * 58350000 * REGISTER 0 IS ZERO --- READ AN RLD/CONTROL RECORD 58400000 * (OR TEXT IF FALL THROUGH FROM ABOVE) 58450000 * 58500000 RDRLD L R8,DECDECPT SET READ LIMIT TO NEXT DECB 58550000 BAL R7,RDREAD AND READ THIS DECB 58600000 * 58650000 RDLSTCHK BAL R7,RDCHECK CHECK THE DECB FOR COMPLETION 58700000 * 58750000 RDRETURN L R13,4(R13) GET POINTER TO LAST SAVE AREA 58800000 RETURN (14,12),T AND RETURN 58850000 EJECT 58900000 *********************************************************************** 58950000 * 59000000 * COMMON READ AND CHECK ROUTINES 59050000 * 59100000 * UPON ENTRY -- REGISTER 9 POINTS TO THE DECB TO READ OR CHECK 59150000 * -- REGISTER 8 POINTS TO A DECB WHICH SHOULD NOT BE 59200000 * READ OTHER THAN FIRST 59250000 * 59300000 * UPON EXIT FROM CHECK -- ALL REGISTERS (EXCEPT 14-15-0-1) ARE 59350000 * THE SAME AS WHEN ENTERED 59400000 * 59450000 * UPON EXIT FROM READ -- REGISTER 9 POINTS TO THE LAST DECB READ 59500000 * ALL OTHERS (EXCEPT 14-15-0-1) ARE THE SAME 59550000 * AS WHEN ENTERED 59600000 * 59650000 * EXIT IS VIA REGISTER 7 59700000 * 59750000 *********************************************************************** 59800000 SPACE 3 59850000 RDREAD READ (R9),SF,MF=E READ DECB POINTED TO BY R9 59900000 C R8,DECDECPT DOES LIMIT EQUAL NEXT DECB 59950000 BCR 8,R7 YES - RETURN 60000000 * 60050000 L R9,DECDECPT NO - GET NEXT DECB POINTER 60100000 B RDREAD AND GO READ IT 60150000 * 60200000 * 60250000 RDCHECK CHECK (R9) CHECK DECB POINTED TO BY R9 60300000 TM CMIOFLGS,CQIOERR ANY I/O ERRORS 60350000 BCR 8,R7 NO - RETURN TO CALLER 60400000 SPACE 60450000 IOABORT L R13,4(R13) YES - PICK UP PREVIOUS SAVE AREA 60500000 C R13,CMFSTSAV IS THIS THE HIGHEST LEVEL 60550000 BNE IOABORT NO - GET PREVIOUS TO THIS 60600000 SPACE 60650000 RETURN (14,12),T YES - RETURN TO HIGHEST LEVEL 60700000 EJECT 60750000 *********************************************************************** 60800000 * 60850000 * PRINT ROUTINE --- ALL OUTPUT TO THE SYSPRINT DATA-SET IS PROCESSED 60900000 * THROUGH THIS ROUTINE 60950000 * 61000000 * NO PARAMETERS ARE PASSED OR RETURNED 61050000 * 61100000 * THE PRINT RECORD ADDRESS IS IN 'CMPUTREC' 61150000 * AN ASA CARRIAGE CONTROL CHARACTER IS INSERTED BEFORE PRINT. 61200000 * THE PROPER CODE IS OBTAINED FROM THE 'PRTCNTRL' TABLE VIA 61250000 * AN INDEX FOUND IN 'CMPRTCTL'. THIS INDEX IS RESET TO SPACE 1 61300000 * UNLESS CHANGED BEFORE THE NEXT PRINT. 61350000 * BEFORE RETURN, 'CMPUTREC' IS UPDATED TO POINT TO A NEW BUFFER. 61400000 * THE NEW BUFFER IS BLANKED AND 'CMWTBFCT' IS ZEROED. 61450000 * 61500000 * IF THE SYSPRINT DATA-SET IS NOT OPEN, A DIRECT RETURN IS MADE 61550000 * 61600000 *********************************************************************** 61650000 SPACE 3 61700000 ENTRY IEWLPRNT 61750000 USING *,R15 61800000 SPACE 61850000 IEWLPRNT B 14(0,15) EXPAND 61900000 DC AL1(8) ENTRY POINT 61950000 DC CL8'IEWLPRNT' IDENTIFIER 62000000 SPACE 62050000 TM CMSTATUS,CQPRTOPN IS THE SYSPRINT DATA SET OPEN 62100000 BO PRNTOPEN YES - GO PROCESS 62150000 * 62200000 SR R15,R15 NO - SET RETURN CODE OK 62250000 STH R15,CMWTBFCT ZERO BYTE COUNT FOR LIST 62300000 BR R14 AND RETURN 62350000 SPACE 2 62400000 PRNTOPEN SAVE (14,12) SAVE CALLERS REGISTERS 62450000 L R12,IOCABASE LOAD CSECT BASE 62500000 DROP R15 DROP ENTRY POINT BASE 62550000 USING IEWLIOCA,R12 AND IDENTIFY CSECT BASE 62600000 L R4,IOCABSE2 LOAD AND IDENTIFY 62610000 USING IEWLIOCA+4096,R4 SECOND BASE REGISTER 62620000 * 62650000 L R13,8(R13) LOAD POINTER TO NEXT SAVE AREA 62700000 * 62750000 L R10,CMWDCBPT LOAD POINTER TO OUTPUT DCB 62800000 L R9,CMWDECPT LOAD POINTER TO DECB CHAIN 62850000 USING IHADCB,R10 IDENTIFY DCB BASE 62900000 USING DECB,R9 IDENTIFY DECB BASE 62950000 L R3,CMPUTREC LOAD POINTER TO LAST RECORD 63000000 SPACE 63050000 SR R7,R7 SET UP FOR 63100000 SR R6,R6 CARRIAGE CONTROL MAINTENANCE 63150000 LH R5,CMLNECNT PICK UP CURRENT LINE-COUNT 63200000 IC R7,CMPRTCTL GET INDEX FOR CONTROL CHARACTER 63250000 IC R6,PRTCNTRL+1(R7) GET SPACE-COUNT 63300000 SR R5,R6 SUBTRACT SPACE-COUNT FROM LINE-COUNT 63350000 BP PRNOEJCT NO OVERFLOW IF POSITIVE 63400000 SPACE 63450000 LA R7,CTEJECT OVERFLOW - GET EJECT INDEX 63500000 LH R5,CMMAXLNE PICK UP MAXIMUM LINE-COUNT 63550000 PRNOEJCT IC R6,PRTCNTRL(R7) PICK UP CONTROL CHARACTER 63600000 STH R5,CMLNECNT STORE CURRENT LINE-COUNT 63650000 LA R7,CTSPACE1 GET SPACE1 INDEX FOR RESET 63700000 STC R6,0(R3) STORE CONTROL CHARACTER INTO BUFFER 63750000 STC R7,CMPRTCTL STORE RESET INDEX FOR NEXT LINE 63800000 SPACE 63850000 AH R3,DCBLRECL ADD RECORD LENGTH TO IT 63900000 L R2,DECAREA LOAD BUFFER POINTER 63950000 AH R2,DCBBLKSI ADD BLOCKSIZE TO IT 64000000 CR R2,R3 WILL ANOTHER RECORD FIT IN THIS BLK 64050000 BH PRNOWRTE YES - BRANCH AROUND WRITE 64100000 * 64150000 * THIS BLOCK MUST BE WRITTEN 64200000 * 64250000 BAL R7,WTWRITE NO - WRITE THIS BLOCK 64300000 * 64350000 L R9,DECDECPT PICK UP POINTER TO NEXT DECB 64400000 BAL R7,WTCHECK AND CHECK IT FOR COMPLETION 64450000 * 64500000 PRNOCHK L R3,DECAREA GET POINTER TO BUFFER 64550000 ST R9,CMWDECPT STORE POINTER TO NEW DECB 64600000 * 64650000 PRNOWRTE ST R3,CMPUTREC STORE NEW RECORD POINTER 64700000 * 64750000 LH R15,CMWLRECL GET BUFFER LENGTH 64770000 BCTR R15,0 DECREMENT FOR 64790000 BCTR R15,0 EXECUTE 64810000 MVI 0(R3),C' ' BLANK THE 64830000 EX R15,PRCLREX BUFFER 64850000 * 64900000 SR R15,R15 ASSUME EVERYTHING OK 64950000 STH R15,CMWTBFCT ZERO BYTE COUNT FOR LIST 65000000 L R13,4(R13) GET POINTER TO CALLERS SAVE AREA 65050000 RETURN (14,12),T 65100000 PRCLREX MVC 1(0,R3),0(R3) CLEARS THE BUFFER 65120000 SPACE 3 65150000 * STANDARD LINKAGE TO WRITE AND CHECK ROUTINES PLUS 'WRITE FLAG' 65200000 * MAINTENANCE 65250000 SPACE 2 65300000 WTWRITE MVI DECDECPT,WRTFLG SET WRITE FLAG IN DECB 65350000 WRITE (R9),SF,MF=E ISSUE THE WRITE 65400000 BR R7 AND RETURN 65450000 SPACE 2 65500000 WTCHECK LA R9,0(R9) INSURE HIGH ORDER BYTE CLEAR 65550000 TM DECDECPT,WRTFLG HAS THIS DECB BEEN WRITTEN 65600000 BCR 8,R7 NO - NO CHECK REQUIRED 65650000 CHECK (R9) YES - CHECK FOR COMPLETION 65700000 NI DECDECPT,X'FF'-WRTFLG TURN OFF THE WRITE FLAG 65750000 BR R7 AND RETURN 65800000 EJECT 65800600 ********************************************************************** 65801200 * * 65801800 * SYSTERM PRINT AND OPEN ROUTINE * 65802400 * * 65803000 * NO PARAMETERS ARE PASSED OR RETURNED. * 65803600 * THE DCB IS POINTED TO BY CMTDCBPT. * 65804200 * THE RECORD TO BE PRINTED IS POINTED TO BY * 65804800 * CMTRMREC. BEFORE RETURN THIS IS UPDATED TO * 65805400 * POINT TO THE OTHER BUFFER, WHICH IS BLANKED. * 65806000 * IF SYSTERM WON'T OPEN, THE TERM OPTION IS SET OFF AND * 65806600 * RETURN IS MADE * 65807200 * * 65807800 ********************************************************************** 65808400 SPACE 4 65809000 ENTRY IEWTERM 65809600 USING *,R15 65810200 IEWTERM SAVE (14,12) SAVE REGISTERS 65810800 L R12,IOCABASE SET UP BASE REGISTER 65811400 DROP R15 65812000 USING IEWLIOCA,R12 65812600 L R4,IOCABSE2 SECOND BASE REGISTER 65813200 USING IEWLIOCA+4096,R4 65813800 L R13,8(R13) SAVE AREA 65814400 L R8,CMTRMREC GET BUFFER POINTER 65815000 L R10,CMTDCBPT GET DCB POINTER 65815600 USING IHADCB,R10 65816200 TM CMFLAG4,CQTRMOPN IS IT OPEN 65816800 BO TRM3 YES. 65817400 * 65818000 * OPEN SYSTERM 65818600 * 65819200 MVC IHADCB(DCBSIZE),MODELDCB MOVE IN DCB MODEL 65819800 MVC DCBDDNAM(8),CMTERMDD MOVE IN DDNAME 65820400 MVC DCBDSORG(2),DSORGPS SET DCB SEQUENTION AND 65821000 MVC DCBMACR(2),MACRWRTE OUTPUT 65821600 O R10,OPENOUT OR OPEN BIT INTO LIST 65822200 ST R10,CMIOLST1 STORE ADDRESS OF DCB 65822800 OI CMIOLST1,X'80' SET LIST DELIMITER 65823400 OPEN MF=(E,CMIOLST1) OPEN IT 65824000 TM DCBOFLGS,DCBOPEN DID IT OPEN OK 65824600 BO TRMOPN YES. 65825200 NI CMPRMFLG,X'FF'-CQTERM NO. SET OFF TERM FLAG A69288 65826221 TRMRET L R13,4(R13) RESTORE REGISTER 13 65826400 RETURN (14,12),T AND RETURN 65827000 * 65827600 * ALLOCATE SYSTERM BUFFERS AND DECBS 65828200 * 65828800 TRMOPN OI CMFLAG4,CQTRMOPN SET ON TERM OPEN FLAG 65829400 LR R9,R8 BUFFER1 POINTER IN R8 AND R9 65830000 LA R9,TRMBUFLN(R9) DECB1 POINTER IN R9 65830600 USING DECB,R9 65831200 XC DECB(DECBSIZE-4),DECB CLEAR IT OUT 65831800 ST R10,DECDCBAD STORE DCB ADDRESS 65832400 ST R8,DECAREA STORE BUFFER ADDRESS 65833000 LR R6,R8 65833600 LA R6,2*TRMBUFLN+DECBSIZE(R6) GET OTHER DECB POINTER 65834200 ST R6,DECDECPT STORE IT 65834800 USING DECB,R6 65835400 MVC DECB(DECBSIZE-4),0(R9) INITIALIZE DECB 65836000 ST R9,DECDECPT STORE DECB POINTER 65836600 LA R9,DECBSIZE(R9) 65837200 ST R9,DECAREA SOTRE BUFFER ADDR 65837800 * 65838400 * WRITE SYSTERM 65839000 * 65839600 USING DECB,R9 65840200 TRM3 LR R9,R8 GET BUFFER POINTER 65840800 LA R9,TRMBUFLN(R9) GET DECB POINTER 65841400 BAL R7,WTWRITE WRITE BUFFER 65842000 L R9,DECDECPT CHECK OTHER DECB 65842600 BAL R7,WTCHECK 65843200 L R3,DECAREA STORE POINTER TO NEW BUFFER 65843800 ST R3,CMTRMREC IN COMMUNICATIONS AREA 65844400 MVI 0(R3),C' ' CLEAN IT OUT 65845000 MVC 1(TRMRECSZ-1,R3),0(R3) 65845600 B TRMRET 65846200 * 65846800 * THESE VCONS MUST BE WITHIN FIRST 4K OF CSECT. 65847400 * 65848000 IOCABASE DC A(IEWLIOCA) CSECT BASE ADDRESS 65848600 IOCABSE2 DC A(IEWLIOCA+4096) SECOND BASE REGISTER CONTENTS 65849200 EJECT 65850000 *********************************************************************** 65900000 * * 65950000 * DCB EXIT ROUTINE --- THIS ROUTINE GAINS CONTROL WHEN ANY DCB 66000000 * IS OPENED AND WHEN CONCATENATION TAKES PLACE ON SYSLIN 66050000 * 66100000 *********************************************************************** 66150000 SPACE 2 66200000 DCBEXIT DS 0F DCB EXIT ADDRESS 66250000 DC X'85' 66300000 DC AL3(OPENEXIT) 66350000 SPACE 2 66400000 OPENEXIT L R13,8(R13) PICK UP NEXT SAVE AREA POINTER 66450000 SAVE (14,12) SAVE REGISTERS 66500000 L R13,8(R13) PICK UP NEXT SAVE FOR ERROR PRINT 66550000 SPACE 66600000 LA R10,0(R1) MOVE DCB POINTER AND CLEAR TOP BYTE 66650000 USING IHADCB,R10 IDENTIFY IT 66700000 SPACE 66750000 L R9,CMERLIST GET POINTER TO ERROR MSG LIST 66800000 OI CMSTATUS,CQRETURN AND SET RETURN REQ FROM ERROR 66850000 * 66900000 C R10,CMWDCBPT IS THIS THE SYSPRINT DCB 66950000 BE EXPRINT YES - ASSUME FIXED 67000000 C R10,CMTDCBPT IS IT SYSTERM 67010000 BE EXTERM YES. BRANCH 67020000 * 67050000 OI CMIOFLGS,CQEOCB SET END OF CONCATENATION ON INPUT 67100000 TM CMLIBFLG,CQAUTOC IS THE AUTO-CALL FLAG ON 67150000 LA R1,CMLINDD POINT TO SYSLIN DDNAME 67200000 BZ EXLIN NO - IT'S SYSLIN 67250000 LA R1,CMLIBDD YES - IT'S SYSLIB 67300000 SPACE 67350000 EXLIN TM DCBRECFM,UNDEFINE IS RECFM UNDEFINED 67400000 BO EXUNDEF YES - PROCESS FOR LOAD MODULE 67450000 * 67500000 TM DCBRECFM,FIXED IS RECFM FIXED 67550000 BO EXINFIX YES - PROCESS FIXED 67600000 * 67650000 TM DCBRECFM,VARIABLE IS RECFM VARIABLE 67700000 BZ EXINFIX NO - ASSUME FIXED 67750000 * 67800000 * AN INPUT DATA SET HAS VARIABLE RECORD FORMAT -- TERMINAL ERROR 67850000 * 67900000 LA R0,ERIOUT3 LOAD ERROR CODE 67950000 BAL R8,EXMSGPRT GO LOG THE MESSAGE 68000000 OI CMIOFLGS,CQIOERR SET I/O ERROR FLAG 68050000 B EXRETURN AND RETURN 68100000 * 68150000 * 68200000 EXPRINT MVI DCBRECFM,FBSA FORCE RECFM=FBSA AND 68250000 LH R5,CMWLRECL R5 = LOGICAL RECORD LENGTH 68300000 DEVTYPE CMPRNTDD,CMXDBLWD DEVTYPE MACRO FOR PRNT SA69255 68310021 LTR R15,R15 TEST FOR SUCCESS SA69255 68320021 BNZ NOPRINT IF NOT, GO GIVE MSG SA69255 68330021 TM CMXDBLWD+2,X'A0' TEST FOR UNIT RECORD SA69255 68340021 BM BLKGOK NOT UNIT RECORD SA69255 68342021 STH R5,DCBBLKSI SET BLKSIZE=LRECL SA69255 68344021 BLKGOK EQU * SA69255 68348421 LA R1,CMPRNTDD POINT TO SYSPRINT DDNAME 68350000 B EXLRECL GO CHECK BUFNO 68400000 NOPRINT EQU * SA69255 68410021 NI DCBOFLGS,X'EF' TURN OFF OPEN FLAG SA69255 68420021 B EXFINISH BRANCH TO FINISH SA69255 68430021 SPACE 68450000 EXINFIX OI DCBRECFM,FB SET FB (S MAY ALSO BE PRESENT) 68500000 NI DCBRECFM,X'FF'-STANDARD TURN OFF STANDARD 68550000 LH R5,DCBLRECL PICK UP LRECL 68600000 LTR R5,R5 IS IT DEFINED 68650000 BNZ EXFIXED YES - LEAVE IT ALONE 68700000 SPACE 68750000 LA R5,80 NO - DEFAULT TO 80 68800000 EXLRECL STH R5,DCBLRECL STORE LRECL 68850000 SPACE 68900000 EXFIXED SR R2,R2 PICK UP NUMBER 68950000 IC R2,DCBBUFNO OF BUFFERS 69000000 LA R3,2 IS IT EQUAL TO 69050000 CR R2,R3 OR GREATER THAN 2 69100000 BH EXNCP YES - ITS OK 69150000 * 69200000 LR R2,R3 NO - FORCE TO 2 69250000 * 69300000 EXNCP STC R2,DCBNCP FORCE NCP TO BUFNO 69350000 * 69400000 LH R7,DCBBLKSI PICK UP BLKSIZE 69450000 LTR R7,R7 IS IT DEFINED 69500000 BNZ EXTRNKCK YES - CHECK IF MULTIPLE OF REC 69550000 * 69600000 STH R5,DCBBLKSI NO - DEFAULT TO LRECL 69650000 B EXFINISH AND GO FINISH UP 69700000 * 69750000 EXTRNKCK SR R6,R6 DIVIDE BLKSIZE 69800000 DR R6,R5 BY LRECL 69850000 LTR R6,R6 IS THE REMAINDER ZERO 69900000 BZ EXFINISH YES - ALL OK 69950000 * 70000000 LA R7,1(R7) NO - ROUND UP TO 70050000 MR R6,R5 MEXT HIGHEST MULTIPLE 70100000 STH R7,DCBBLKSI AND STORE INTO DCB 70150000 EXERR LA R0,ERINPT1 LOG ERROR 70200000 BAL R8,EXMSGPRT 'INVALID BLKSIZE' 70250000 B EXFINISH GO FINISH UP 70300000 * 70350000 * 70400000 EXTERM MVI DCBRECFM,FSA FORCE FIXED FORMAT 70404000 LA R5,TRMRECSZ GET RECORD SIZE 70408000 LA R1,CMTERMDD 70412000 STH R5,DCBLRECL FORCE RECORD SIZE 70416000 STH R5,DCBBLKSI FORCE BLOCKSIZE 70418021 MVI DCBNCP,2 FORCE 2 BUFFERS 70420000 B EXFINISH GO TO FINISHING CODE 70430021 EXUNDEF MVI DCBNCP,2 FORCE NCP=2 FOR LOAD MODULES 70450000 * 70500000 * 70550000 EXFINISH EQU * 70600000 EXZERO MVI DCBBUFNO,X'00' ZERO BUFNO IN DCB 70650000 EXRETURN NI CMSTATUS,X'FF'-CQRETURN TURN OFF RETURN REQ BIT 70700000 L R13,4(R13) LOAD PREV SAVE AREA POINTER 70750000 LM R14,R12,12(R13) RELOAD REGISTERS 70800000 L R13,4(R13) LOAD PREV SAVE AREA POINTER 70850000 BR R14 AND RETURN 70900000 SPACE 2 70950000 EXMSGPRT TM CMSTATUS,CQMSGSAV SHOULD MESSAGE BE SAVED 71000000 BZ EXPRTMSG NO - GO PRINT IT 71050000 SPACE 71100000 OI CMSTATUS,CQOPNERR YES - INDICATE ONE SAVED 71150000 STM R0,R1,0(R9) SAVE INFO ABOUT MESSAGE 71200000 BR R8 AND RETURN TO PROCESSING 71250000 SPACE 71300000 EXPRTMSG L R15,ADRERROR GET POINTER TO ERROR ROUTINE 71350000 BALR R14,R15 AND GO LOG THE ERROR 71400000 BR R8 RETURN TO PROCESSING 71450000 SPACE 2 71500000 EODAD OI CMIOFLGS,CQEOFB+CQEOCB SET EOF AND EOC ON INPUT 71550000 BR R14 71600000 EJECT 71650000 *********************************************************************** 71700000 * * 71750000 * SYNAD EXIT ROUTINE -- THIS ROUTINE GAINS CONTROL WHEN A * 71800000 * SYNCHRONOUS I/O ERROR OCCURRS. IT PRINTS THE ERROR, ACCEPTS * 71850000 * THE ERROR AND RETURNS CONTROL. * 71900000 * * 71950000 *********************************************************************** 72000000 SPACE 3 72050000 SYNAD L R5,8(R13) GET POINTER TO NEXT SAVE AREA 72100000 USING IHADCB,R10 IDENTIFY DCB 72150000 OI CMSTATUS,CQRETURN SET RETURN REQUEST FROM ERROR 72200000 LA R2,8 72250000 L R3,DECIOBPT GET THE RIGHT IOB POINTER 72300000 L R6,DCBIOBA SAVE CONTENTS OF THIS SLOT 72350000 SR R3,R2 DECRIMENT BY 8 72400000 ST R3,DCBIOBA AND STORE FOR SYNADAF 72450000 TM DCBDSORG,X'02' IS DCB PARTITIONED ORGANIZATION 72500000 BO SYNBPAM YES - GO AROUND 72550000 SPACE 72600000 SYNADAF ACSMETH=BSAM NO - GIVE SYNAD MACRO FOR BSAM 72650000 B SYNSAVE AND GO PRINT ERROR 72700000 SPACE 72750000 SYNBPAM SYNADAF ACSMETH=BPAM GIVE SYNAD MACRO FOR BPAM 72800000 SPACE 72850000 SYNSAVE ST R5,8(R13) INSERT THE SYNAD PROVIDED 72900000 ST R13,4(R5) SAVE AREA INTO LOADER CHAIN 72950000 SAVE (14,12) SAVE REGISTERS 73000000 LR R13,R5 GET NEXT SAVE AREA 73050000 SPACE 73100000 SPACE 73150000 LA R0,ERIOUT2 LOAD ERROR MESSAGE NUMBER 73200000 LA R1,59(R1) ADDRESS OF SYNAD MESSAGE 73250000 L R15,ADRERROR ADDRESS OF ERROR ROUTINE 73300000 BALR R14,R15 AND GO LOG THE ERROR 73350000 SPACE 73400000 L R13,4(R13) GET PREVIOUS SAVE AREA 73450000 LM 14,12,12(13) RELOAD REGISTERS 73500000 ST R6,DCBIOBA RESTORE IOB POINTER FOR DATA MGMT 73550000 SPACE 73600000 SYNADRLS RELEASE SYNAD STORAGE 73650000 SPACE 73700000 ST R5,8(R13) RE-CHAIN THE 73750000 ST R13,4(R5) LOADER SAVE AREAS 73800000 OI CMIOFLGS,CQIOERR IDENTIFY I/O ERROR 73850000 BR R14 AND RETURN FOLLOWING CHECK 73900000 EJECT 73950000 PARMLIST EQU * 74000000 SPACE 74050000 NEGATE EQU * 74100000 VPNOMAP DC C'NO' 74150000 VPMAP DC C'MAP' 74200000 VPNOLET DC C'NO' 74250000 VPLET DC C'LET' 74300000 VPNOCALL DC C'NO' 74350000 VPCALL DC C'CALL' 74400000 VPNCAL DC C'NCAL' 74450000 VPNORES DC C'NO' 74500000 VPRES DC C'RES' 74550000 VPNOPRNT DC C'NO' 74600000 VPPRINT DC C'PRINT' 74650000 VPSIZE DC C'SIZE=' 74700000 VPEP DC C'EP=' 74800000 VPNAME DC C'NAME=' 74810000 VPTERM DC C'TERM' 74820000 VPNOTERM DC C'NOTERM' 74830000 EJECT 74850000 ORINDEX EQU ORPARM-SETPARM 74900000 ANDINDEX EQU ANDPARM-SETPARM 74950000 SIZEINDX EQU SIZEPARM-SETPARM 75000000 EPINDEX EQU EPPARM-SETPARM 75050000 NAMEINDX EQU NAMEPARM-SETPARM 75070000 CQFF EQU X'FF' 75100000 SPACE 2 75150000 PRMMAP EQU VPMAP-PARMLIST INDEX TO OPTION MAP 75200000 PRMNOMAP EQU VPNOMAP-PARMLIST INDEX TO OPTION NOMAP 75250000 PRMLET EQU VPLET-PARMLIST INDEX TO OPTION LET 75300000 PRMNOLET EQU VPNOLET-PARMLIST INDEX TO OPTION NOLET 75350000 PRMCALL EQU VPCALL-PARMLIST INDEX TO OPTION CALL 75400000 PRMNOCAL EQU VPNOCALL-PARMLIST INDEX TO OPTION NOCALL 75450000 PRMPRINT EQU VPPRINT-PARMLIST INDEX TO OPTION PRINT 75500000 PRMNOPRT EQU VPNOPRNT-PARMLIST INDEX TO OPTION NOPRINT 75550000 PRMRES EQU VPRES-PARMLIST INDEX TO OPTION RES 75600000 PRMNORES EQU VPNORES-PARMLIST INDEX TO OPTION NORES 75650000 PRMEP EQU VPEP-PARMLIST INDEX TO OPTION EP 75700000 PRMNAME EQU VPNAME-PARMLIST INDEX TO OPTION HNAME' 75720000 PRMSIZE EQU VPSIZE-PARMLIST INDEX TO OPTION SIZE 75750000 PRMNCAL EQU VPNCAL-PARMLIST INDEX TO OPTION NCAL 75800000 PRMTERM EQU VPTERM-PARMLIST INDEX TO OPTION TERM 75810000 PRMNOTRM EQU VPNOTERM-PARMLIST INDEX TO OPTION NOTERM 75820000 EJECT 75850000 *********************************************************************** 75900000 * * 75950000 * LIST USED FOR SCANNING VALID OPTIONS PASSED IN THE PARAMETER LIST * 76000000 * * 76050000 * EACH ENTRY IS 4 BYTES LONG * 76100000 * FIRST BYTE -- INDEX FROM 'PARMLIST' TO VALID OPTION NAME * 76150000 * SECOND BYTE -- MASK USED FOR SETTING OR CLEARING OPTION FLAG * 76200000 * THIRD BYTE -- LENGTH-1 OF OPTION NAME * 76250000 * FORTH BYTE -- INDEX INTO EXECUTE LIST FOR PERFORMING OPERAT'N* 76300000 * * 76350000 *********************************************************************** 76400000 SPACE 3 76450000 SCANLIST DS 0F 76500000 DC AL1(PRMMAP),AL1(CQMAP),AL1(2),AL1(ORINDEX) 76550000 DC AL1(PRMLET),AL1(CQLET),AL1(2),AL1(ORINDEX) 76600000 DC AL1(PRMSIZE),AL1(0),AL1(3),AL1(SIZEINDX) 76650000 DC AL1(PRMEP),AL1(0),AL1(1),AL1(EPINDEX) 76700000 DC AL1(PRMNAME),AL1(0),AL1(3),AL1(NAMEINDX) 76720000 DC AL1(PRMNCAL),AL1(CQFF-CQCALL-CQRES),AL1(3),AL1(ANDINDEX) 76750000 DC AL1(PRMNOMAP),AL1(CQFF-CQMAP),AL1(4),AL1(ANDINDEX) 76800000 DC AL1(PRMNOCAL),AL1(CQFF-CQCALL-CQRES),AL1(5),AL1(ANDINDEX) 76850000 DC AL1(PRMNORES),AL1(CQFF-CQRES),AL1(4),AL1(ANDINDEX) 76900000 DC AL1(PRMNOPRT),AL1(CQFF-CQPRINT),AL1(6),AL1(ANDINDEX) 76950000 DC AL1(PRMPRINT),AL1(CQPRINT),AL1(4),AL1(ORINDEX) 77000000 DC AL1(PRMRES),AL1(CQRES+CQCALL),AL1(2),AL1(ORINDEX) 77050000 DC AL1(PRMCALL),AL1(CQCALL),AL1(3),AL1(ORINDEX) 77100000 DC AL1(PRMNOLET),AL1(CQFF-CQLET),AL1(4),AL1(ANDINDEX) 77150000 DC AL1(PRMTERM),AL1(CQTERM),AL1(3),AL1(ORINDEX) 77160000 DC AL1(PRMNOTRM),AL1(CQFF-CQTERM),AL1(5),AL1(ANDINDEX) 77170000 LISTEND EQU * 77200000 SCANCTRL DC A(SCANLIST),F'4',A(LISTEND-4) 77250000 EJECT 77300000 *********************************************************************** 77350000 * * 77400000 * LIST USED FOR RECONSTRUCTING OPTIONS SPECIFIED 77450000 * 77500000 * EACH ENTRY IS 4 BYTES LONG 77550000 * FIRST BYTE -- MASK USED FOR TESTING IF OPTION PRESENT 77600000 * SECOND BYTE -- LENGTH-1 OF OPTION NAME 77650000 * THIRD AND FORTH -- INDEX FROM 'PARMLIST' TO OPTION NAME 77700000 * * 77750000 *********************************************************************** 77800000 SPACE 2 77850000 OPUSELST DS 0F 77900000 DC AL1(CQPRINT),AL1(4),AL2(PRMPRINT) 77950000 DC AL1(CQMAP),AL1(2),AL2(PRMMAP) 78000000 DC AL1(CQLET),AL1(2),AL2(PRMLET) 78050000 DC AL1(CQCALL),AL1(3),AL2(PRMCALL) 78100000 DC AL1(CQRES),AL1(2),AL2(PRMRES) 78150000 DC AL1(CQTERM),AL1(3),AL2(PRMTERM) 78170000 ENDOPUSE EQU * 78200000 SPACE 78250000 OPTCNTRL DC A(OPUSELST),F'4',A(ENDOPUSE-4) 78300000 EJECT 78350000 SPACE 2 78400000 *********************************************************************** 78450000 * * 78500000 * ASA CARRIAGE CONTROL CHARACTER DEFINITIONS 78550000 * THEY MUST REMAIN IN THE ORDER DEFINED IN THE 'CTPRTCTL' 78600000 * DSECT EXPANDED WITH IEWLOCOM 78650000 * * 78700000 *********************************************************************** 78750000 SPACE 3 78800000 PRTCNTRL DS 0F 78850000 SPACE 78900000 DC C' ',AL1(1) SPACE 1 78950000 DC C'0',AL1(2) SPACE 2 79000000 DC C'-',AL1(3) SPACE 3 79050000 DC C'1',AL1(60) EJECT 79100000 EJECT 79150000 ADRERROR DC V(IEWERROR) ERROR ROUTINE ENTRY POINT 79250000 ADRBUFFR DC A(IEWBUFFR) ADDRESS OF BUFFER ALLOCATION 79300000 ADRPRIME DC A(IEWPRIME) ADDRESS OF OBJECT BUFFER PRIME 79350000 ADRPRNT DC A(IEWLPRNT) PRINT ROUTINE ENTRY POINT 79400000 ADROMPRC DC V(IEWLRELO) ADDRESS OF OBJECT MODULE PROCESSOR 79450000 ADRLMPRC DC V(IEWLODE) ADDRESS OF LOAD MODULE PROCESSOR 79500000 ADRACALL DC V(IEWACALL) ADDRESS OF AUTO-CALL PROCESSOR 79550000 ADRABTMP DC V(IEWBTMAP) BIT MAP PROCESSOR ENTRY POINT 79600000 ADRCDE DC V(IEWLIDEN) ADDRESS OF CDE CONSTRUCTOR 79620000 DFLTMIN DC A(MINREQ) MINIMUM STORAGE REQUEST 79650000 DFLTNAME DC C'**GO ' 79660000 DFLTTERM DC C'SYSTERM ' DEFAULT DIAGNOSTIC DDNAME 79670000 EXTRN IEWLDDEF 79700000 DFLTBASE DC A(IEWLDDEF) DEFAULT OPTIONS CSECT 79750000 SPACE 79800000 DUMMYDCB EQU 0 79850000 OPENIN OPEN (DUMMYDCB,(INPUT,DISP)),MF=L 79900000 OPENOUT OPEN (DUMMYDCB,(OUTPUT,DISP)),MF=L 79950000 CLOSE CLOSE (DUMMYDCB,DISP),MF=L 80000000 EXTR EXTRACT EXTR,'S',FIELDS=(TSO),MF=L 80010000 TCBTSTSK EQU X'80' TIMESHARING FLAG IN TCBTSFLG FIELD 80020000 SPACE 80050000 DBLMASK DS 0F 80100000 DC X'00FFFFF8' DOUBLE WORD MASK 80150000 FULMSK DS 0F 80156000 DC X'00FFFFFC' FULLWORD MASK 80162000 ENTFLG2 DC X'FF000000' 80170000 SPACE 80200000 DSORGPS DC BL2'0100000000000000' PHISICAL SEQUENTIAL 80250000 DSORGPO DC BL2'0000001000000000' PARTITIONED ORGANIZATION 80300000 MACRREAD DC BL2'0010000000000000' READ 80350000 MACRWRTE DC BL2'0000000000100000' WRITE 80400000 SPACE 80450000 LOADHEAD DC C'OS/360 LOADER' 80500000 HDGLNGTH EQU *-LOADHEAD 80550000 OKOPTHDG DC C'OPTIONS USED -' 80600000 OKOPTLNG EQU *-OKOPTHDG 80650000 REJOPT DC C'OPTIONS REJECTED -' 80700000 REJOPTLG EQU *-REJOPT 80750000 MAPHEAD DC C'NAME TYPE ADDR' 80800000 MAPHDLNG EQU *-MAPHEAD 80850000 ENTRYSZ EQU 24 SIZE OF MAP ENTRY 80851000 SPACE 80852000 * 80854000 * 81 CHARACTER RECORD 80856000 * THESE THREE FIELDS MOVED TO CMMAPLIN,CMWLRECL,CMMAXLST 80858000 * IF TSO IS OPERATING. 80860000 * 80862000 DS 0H 80864000 PRNT81 DC AL2(LN81) LENGTH OF MAP LINE 80866000 LN81 EQU 3*ENTRYSZ THREE ENTRIES PER LINE 80868000 DC H'81' LENGTH OF RECORD 80870000 DC H'60' LENGTH OF INVALID OPTIONS 80872000 * 80874000 * 121 CHARACTER RECORD 80876000 * THESE THREE FIELDS MOVED TO CMMAPLIN,CMWLRECL,CMMAXLST 80878000 * IF TSO IS NOT OPERATING. 80880000 * 80882000 PRNT121 DC AL2(LN121) LENGTH OF MAP LINE 80884000 LN121 EQU 5*ENTRYSZ FIVE ENTRIES PER LINE 80886000 DC H'121' LENGTH OF RECORD 80888000 DC H'100' LENGTH OF INVALID OPTIONS 80890000 * 80892000 SPACE 80900000 DMSIZE EQU 6144 INITMAIN REQUEST SIZE A42698 80950021 MINREQ EQU 2048 MINIMUM VC REQUEST SIZE 81000000 NUMSAVES EQU 9 NUMBER OF SAVE AREAS ALLOCATED 81050000 TRMBUFLN EQU 88 LENGTH OF SYSTERM BUFFER (DBLWRDS) 81060000 TRMRECSZ EQU 81 LENGTH OF SYSTERM RECORD 81070000 RLDSIZE EQU 256 81100000 FSA EQU B'10001100' FIXED,STANDARD,ASA 81120000 FBSA EQU B'10011100' FIXED,BLOCKED,STANDARD,ASA 81150000 FB EQU B'10010000' FIXED, BLOCKED 81200000 STANDARD EQU B'00001000' STANDARD BLOCKS ONLY 81250000 UNDEFINE EQU X'C0' UNDEFINED RECFM IN DCB 81300000 FIXED EQU X'80' FIXED RECORD FORMAT IN DCB 81350000 VARIABLE EQU X'40' VARIABLE RECORD FORMAT IN DCB 81400000 CHAINED EQU X'20' CHAINED SCHED IN OPTCD OF DCB 81450000 WRTFLG EQU X'80' DECB WRITTEN BUT NOT CHECKED 81500000 DCBOPEN EQU X'10' BIT SET IF OPEN WAS SUCCESSFUL 81550000 UNLKATRB EQU X'08' UNLIKE ATTRIBUTES BIT IN DCBOFLGS 81600000 SPACE 2 81650000 R0 EQU 0 81700000 R1 EQU 1 81750000 R2 EQU 2 81800000 R3 EQU 3 81850000 R4 EQU 4 81900000 R5 EQU 5 81950000 R6 EQU 6 82000000 R7 EQU 7 82050000 R8 EQU 8 82100000 R9 EQU 9 82150000 R10 EQU 10 82200000 R11 EQU 11 82250000 R12 EQU 12 82300000 R13 EQU 13 82350000 R14 EQU 14 82400000 R15 EQU 15 82450000 MAINTAIN DS 40F MAINTENANCE AREA 82470000 SPACE 2 82500000 EJECT 82600000 DS 0D 82650000 MODELDCB DCB DDNAME=SYSPRINT,EODAD=EODAD,EXLST=DCBEXIT,SYNAD=SYNAD, X82700000 DEVD=DA,DSORG=PS,MACRF=(W) 82750000 DS 0D 82800000 DCBSIZE EQU *-MODELDCB 82850000 EJECT 82900000 DCBD DSORG=BS,DEVD=DA 82950000 EJECT 83000000 IEWLDCOM 83050000 EJECT 83100000 *********************************************************************** 83150000 * * 83200000 * DATA EVENT CONTROL BLOCK DEFINITION * 83250000 * * 83300000 * IF THE DECB IS CHANGED BY DATA MANAGEMENT, THIS DSECT MUST * 83350000 * BE CHANGED. * 83400000 * * 83450000 * ONE EXTRA WORD HAS BEEN ADDED AT THE END OF THE NORMAL DECB * 83500000 * FOR CONTROLLING MULTIPLE BUFFERS. * 83550000 * * 83600000 *********************************************************************** 83650000 SPACE 3 83700000 DECB DSECT 83750000 SPACE 83800000 DECSDECB DC F'0' EVENT CONTROL BLOCK 83850000 DECTYPE DC H'0' I/O MACRO TYPE 83900000 DECLNGTH DC H'0' LENGTH OF DATA 83950000 DECDCBAD DC A(0) ADDRESS OF DCB 84000000 DECAREA DC A(0) ADDRESS OF BUFFER 84050000 DECIOBPT DC A(0) ADDRESS OF IOB 84100000 DECDECPT DC A(0) ADDRESS OF NEXT DECB 84150000 DECBSIZE EQU *-DECB 84200000 EJECT 84250000 *********************************************************************** 84300000 * * 84350000 * DSECT OF 'IEWLDDEF' CSECT -- DEFAULT OPTIONS DEFINITION * 84400000 * * 84450000 * IF THE SYSGEN MACRO 'SGIEW050' IS ALTERED TO CAUSE A CHANGE * 84500000 * IN THE DISPLACEMENTS OF ANY OF THE FOLLOWING DEFINITIONS, * 84550000 * THIS DSECT MUST BE CORRESPONDINGLY ALTERED. * 84600000 * * 84650000 *********************************************************************** 84700000 SPACE 3 84750000 DEFAULTS DSECT 84800000 SPACE 84850000 DFLTDDNM EQU * 84900000 DFLTPRNT DC CL8'SYSPRINT' DIAGNOSTIC MESSAGE DATA SET 84950000 DFLTLIN DC CL8'SYSLIN' PRIMARY INPUT DATA SET 85000000 DFLTLIB DC CL8'SYSLIB' AUTO-CALL LIBRARY DATA SET 85050000 SPACE 85100000 DFLTSIZE DC F'102400' DEFAULT SIZE 85150000 SPACE 85200000 DFLTFLAG DC B'00010101' SELF-DEFINING KEYWORD OPTIONS 85250000 DFLTXTRA DC B'00000000' RESERVED FOR EXPANSION 85300000 EJECT 85350000 * DSECT FOR INITIAL MAIN STORAGE (UNCONDITIONAL) REQUEST 85400000 SPACE 85450000 INITMAIN DSECT 85500000 INITSAVE DS 18F INITIAL SAVE AREA 85550000 SPACE 85600000 * EVERYTHING IN THE BOX MUST REMAIN TOGETHER AND IN THE SAME ORDER. 85650000 * IT IS MOVED TO 'CMINITCM' IN ONE PIECE. IF IT IS CHANGED, THE 85700000 * CORRESPONDING AREA IN THE COMMUNICATION DSECT MUST BE CHANGED. 85750000 SPACE 85800000 INITCMCM EQU * ******************************************** 85850000 INITMADR DS F * VC MAIN STORAGE ADDRESS * 85900000 INITMSIZ DS F * VC MAIN STORAGE SIZE * 85950000 INITDDNM EQU * * * 86000000 INITPRNT DS 8C * DDNAME FOR PRINT * 86050000 INITLIN DS 8C * DDNAME FOR THE PRIMARY INPUT * 86100000 INITLIB DS 8C * DDNAME FOR THE LIBRARY * 86150000 INITTERM DS 8C * DDNAME FOR DIAGNOSTICS * 86170000 INITNAME DS 8C * PARAMETER LIST ENTRY POINT NAME * 86200000 INITPGMN DS 8C * PROGRAM NAME * 86210000 INLINDCB DS F * ADDR OF PASSED SYSLIN DCB * 86220000 INLIBDCB DS F * ADDR OF PASSED SYSLIB DCB * 86230000 INITPARM DS H * PARAMETER FLAGS AND ERROR FLAGS * 86250000 INFLAG3 DS X * ASSORTED FLAGS * 86260000 INFLAG4 DS X * ASSORTED FLAGS * 86270000 INITCMSZ EQU *-INITCMCM ******************************************** 86300000 INITSPIE DS F POINTER TO PREVIOUS SPIE FOR 'SIZE=' SCAN 86350000 INITSCAN DS F SCAN POINTER SAVE AREA FOR 'SIZE=' SPIE 86400000 INITDUM DS F SAVE WORD FOR REGISTER DURING SIZE 86410000 * PROCESSING 86420000 INITREJL DS F END OF REJECTED OPTIONS LIST 86450000 INITRMIN DS F MINIMUM SIZE REQUEST FOR VC 86500000 INITRMAX DS F MAXIMUM SIZE REQUEST FOR VC 86550000 INITGTML GETMAIN MF=L LIST FOR VC GETMAIN 86600000 INITEXTR EXTRACT INITEXAD,'S',FIELDS=(TSO),MF=L LIST FOR EXTRACT 86610000 EXTRLEN EQU *-INITEXTR 86620000 INITEXAD DS F EXTRACT WILL PUT ADDRESS OF TSO 86630000 * FIELD HERE 86640000 INITDBLW DS 0D DOUBLE WORD FOR 86650000 DS 7X PARM 'SIZE' CONVERT 86700000 INITSIGN DS X SIGN POSITION FOR PACKED FORMAT 86750000 INITRTAB DS 32D 86800000 INITREJP EQU * REJECTED OPTIONS BUFFER 86850000 INITSIZE EQU *-INITMAIN 86900000 END IEWLIOCA 86950000 ./ ADD SSI=00011363,NAME=IEWLDLIB,SOURCE=0 LIBR TITLE 'IEWLLIBR' 00070000 *TITLE 'IEWLLIBR' -LIBRARY PROCESSOR * 00140000 *STATUS-CHANGE LEVEL 20 00180000 * INCREMENTAL 288 - W-CON - ADDED INC288 00220000 * TSO CHANGES FOR IDENTIFY AND INCORE DATA SET * 00250000 *RELEASE 21 DELETIONS/CHANGES 00260021 * 00270021 *713800-713920 A56493 00272021 *SEE FIX FOR SA70542 A60691 00274021 * M5453 00276021 * M5454 00278021 *I211600,A379200-379320 SA70542 00278421 *FUNCTION/OPERATION: * 00280000 * 1)IEWACALL-TRYS TO RESOLVE EXTERNAL REFERENCES IN THE CESD, * 00350000 * WHICH ARE STILL UNRESOLVED AT THE END OF THE PRIMARY * 00420000 * INPUT STREAM. IT CALLS FROM PARTITIONED DATA SETS, * 00490000 * (OR OPTIONALLY FROM THE LINK PACK AREA) * 00560000 * MEMBERS WHOSE NAMES ARE EXTERNAL REFERENCES IN THE * 00630000 * CESD. IT DETERMINES WHETHER THE CALLED MEMBERS ARE * 00700000 * OBJECT MODULES OR LOAD MODULES. THEN PASSES CONTROL * 00770000 * TO THE APPROPRIATE PROCESSOR. * 00840000 * * 00910000 * 2)IEWLODE-DETERMINES RECORD TYPE, THEN PASSES CONTROL TO THE * 00980000 * APPROPRIATE ROUTINE FOR RECORD PROCESSING. * 01050000 * * 01120000 * 3)LMTXT-PROCESSES LOAD MODULE TEXT. * 01190000 * * 01260000 * 4)COMMON-ASSIGNS ADDRESSES TO COMMON. * 01330000 * * 01400000 * 5)PSEUDOR-ASSIGNS DISPLACEMENTS TO PSEUDO REGISTERS * 01470000 * * 01540000 * 6)FINISHUP-PRINTS FINISHING MESSAGES-UNRESOLVED ER'S, * 01610000 * TOTAL LENGTH,ENTRY ADDRESS. ASSIGNS ENTRY POINT * 01680000 * * 01750000 * 7)IEWERROR-FORMATS AND PRINTS ERROR MESSAGES. LOGS * 01820000 * ERROR IN BIT MAP. * 01890000 * * 01960000 * 8)IEWBTMAP-PRINTS THE DIAGNOSTIC MESSAGE DIRECTORY * 02030000 * FOR ERRORS LOGGED IN THE BIT MAP * 02100000 * * 02170000 *ENTRY POINTS: * 02240000 * 1)IEWACALL-FOR AUTOMATIC LIBRARY CALL PROCESSING * 02310000 * 2)IEWLODE-FOR LOAD MODULE PROCESSING * 02380000 * 3)IEWERROR-FOR PRINTING AND LOGGING ERROR MESSAGES * 02450000 * 4)IEWBTMAP-FOR PRINTING DIAGNOSTIC MESSAGES FOR ERRORS * 02520000 * LOGGED IN BIT MAP * 02590000 * * 02660000 *INPUT: ALL ROUTINES EXPECT * 02730000 * #13-ADDRESS OF SAVE AREA * 02800000 * #14-RETURN ADDRESS * 02870000 * #15-ADDRESS OF THEIR ENTRY POINT * 02940000 * #11-ADDRESS OF COMMUNICATION AREA * 03010000 * IN ADDITION-IEWERROR EXPECTS * 03080000 * #0-ERROR CODE * 03150000 * #1-POINTER TO QUALIFYINY DATA(IF ANY) * 03220000 *EXTERNAL ROUTINES: * 03290000 * IEWOPNLB-OPEN SYSLIB * 03360000 * IEWLRLD-PROCESSES RLD'S * 03430000 * IEWLREAD-READ CONTROL AND TEXT RECORDS * 03500000 * IEWLESD-PROCESSES CESD * 03570000 * IEWLEND-PROCESSES END OF MODULE * 03640000 * TRANSID-TRANSLATES ESDID TO TRANSLATION TABLE ENTRY ADDRESS * 03710000 * IEWLMAP-CREATES MAP PRINTOUT * 03780000 * IEWLPRNT-PRINTS MESSAGES * 03850000 * IEWLERTN-RELOCATES RLD'S * 03920000 * IEWPRIME-PRIMES BUFFERS * 03990000 * IEWLRELO-PROCESS OBJECT MODULES * 04060000 * IEWLCNVT-CONVERTS BINARY QUANTITIES TO PRINTABLE HEX * 04130000 * IEWTERM - PRINTS DIAGNOSTICS ON SYSTERM * 04160000 *EXITS-NORMAL:TO CALLER L 13,4(13) * 04200000 * SR 15,15 * 04270000 * RETURN (14,12),T,RC=(15) * 04340000 * * 04410000 * -ERROR:TO IEWERROR LA 0,ERCODE * 04480000 * L 15,V(IEWERROR) * 04550000 * BALR 14,15 * 04620000 * * 04690000 *TABLES/WORKAREAS:REFER TO LOADER PLM FOR DETAILED DESCRIPTION * 04760000 * 1)CESD * 04830000 * 2)TRANSLATION TABLE * 04900000 * 3)BLDL LIST * 04970000 * 4)COMMUNICATIONS AREA(IEWLOCOM) * 05040000 *ATTRIBUTES:READ ONLY,REUSABLE,REENTRANT * 05110000 *NOTES: NONE * 05180000 * * 05250000 *********************************************************************** 05320000 EJECT 05390000 IEWLLIBR CSECT 05460000 *C059500 S21016 05490021 *C757400 M1797 05500021 IEWACALL EQU * 05530000 ENTRY IEWACALL 05600000 ENTRY IEWLODE 05670000 CQFF EQU X'FF' 05740000 EMVT EQU X'10' MVT SYSTEM 05810000 EMFT EQU X'20' MFT SYSTEM 05840000 ECESD EQU X'20' CESD RECORD 05880000 ESYMSCAT EQU X'D0' SYM, IDR, OR SCAT/TRANS S21016 05950021 ETXT EQU X'01' TEXT RECORD 06020000 ERLD EQU X'02' RLD RECORD 06090000 ELAST EQU X'08' END OF MODULE 06160000 ELTXT EQU X'08' TXT REC LAST IN MODULE 06230000 ELENGTH EQU 2 DISPLACEMENT OF LENGTH 06300000 EIDLNG EQU 4 LENGTH OF ENTRY IN ID/LENGTH 06370000 ERLDFLG EQU X'0C' FLAG FOR RLD 06440000 ERLDADDR EQU 4 FLAG-ADDRESS 06510000 EBLDLRC EQU X'08' RETURN CODE-BLDL ERROR 06580000 EBLDLTTR EQU 8 TTR 06650000 EBLDLDIS EQU 4 SIZE OF BLDL LIST DISCRIPTION 06720000 EADRLENT EQU 4 ENTRY SIZE IN ADDRESS LIST 06790000 EBLDLR EQU 10 R 06860000 EBLDLSIZ EQU 20 BYTES NEEDED FOR EACH BLDL 06930000 * ENTRY 07000000 EBLDLENT EQU 16 SIZE OF ENTRY 07070000 * FIELD 07140000 ESDNAME EQU 4 NAME 07210000 ERTYPE EQU X'02' 07280000 ESDRELCH EQU 12 PTR TO RELOCATION CHAIN 07350000 ESDCHADR EQU 0 CHAIN ADDRESS TO NEXT ENTRY 07420000 ESDCMCHN EQU 16 PTR TO CHAINED CM ENTRY 07490000 ESDTYPE EQU 12 TYPE 07560000 ESDLAA EQU 12 LINK EDIT ASSIGNED ADDRESS 07630000 ESDLNG EQU 16 LENGTH OF CONTROL SECTION 07700000 ESDRELOC EQU 16 RELOCATION CONSTANT 07770000 ESDPRALN EQU 16 ALIGNMENT VALUE 07840000 ETTR EQU X'10' TTR RECEIVED BIT IN DESD 07910000 EBLDLATT EQU X'20' BLDL ATTEMPTED BIT IN CESD 07980000 EDELETE EQU X'80' DELETE BIT IN CESD 08050000 ZERO EQU 0 08120000 ENCAL EQU X'08' NEVER CALL BIT IN CESD 08190000 WEAKCALL EQU X'40' W-CON BIT IN CESD INC288 08200000 ECXDADR EQU 4 08260000 PARM EQU 1 08330000 WORKA EQU 2 08400000 WORKB EQU 3 08470000 CUM EQU 4 08540000 ID EQU 5 08610000 ADR EQU 6 08680000 LNG EQU 7 08750000 PTR EQU 8 08820000 CESD EQU 9 08890000 MAINT EQU 10 08960000 CMPTR EQU 11 09030000 BASE EQU 12 09100000 SAVEREG EQU 13 09170000 RETURN EQU 14 09240000 BRANCH EQU 15 09310000 R0 EQU 0 09380000 R1 EQU 1 09450000 R2 EQU 2 09520000 R3 EQU 3 09590000 R4 EQU 4 09660000 R5 EQU 5 09730000 R6 EQU 6 09800000 R7 EQU 7 09870000 R8 EQU 8 09940000 R9 EQU 9 10010000 R10 EQU 10 10080000 R11 EQU 11 10150000 R12 EQU 12 10220000 R13 EQU 13 10290000 R14 EQU 14 10360000 R15 EQU 15 10430000 TRMRECSZ EQU 81 LENGTH OF SYSTERM RECORD 10460000 USING *,15 10500000 SAVE (14,12),T,* SAVE CALLERS REGISTERS 10570000 LR BASE,15 PUT BASE ADDR IN BASE REG 10640000 DROP 15 10710000 USING IEWACALL,BASE ESTABLISH BASE 10780000 USING ERCODES,0 10850000 L SAVEREG,8(SAVEREG) NEW SAVE AREA ADDRESS 10920000 USING IEWLDCOM,CMPTR COMMUNICATION AREA 10990000 OI CMLIBFLG,CQAUTOC AUTOCALL IN PROCESS 11060000 TM CMPRMFLG,CQCALL AUTOCALL 11130000 BZ COMMON NO-ASSIGN ADDR TO COMMON 11200000 L CESD,CMERCHN GET PTR TO ER CHAIN 11270000 LTR CESD,CESD ER CHAIN EMPTY 11340000 BZ COMMON YES-ASSIGN ADDR TO COMMON 11410000 TM CMPRMFLG,CQRES LIBRARY RESIDENT IN LPA 11480000 BZ OPNLIB NO-OPEN SYSLIB 11550000 * 11620000 *********************************************************************** 11690000 * 11760000 * CHECK FOR MVT SYSTEM 11830000 * 11900000 *********************************************************************** 11970000 * 12040000 LA ADR,16 GET ADDR OF PTR TO CVT 12110000 L PTR,0(ADR) GET ADDR OF CVT 12180000 USING CVTSECT,PTR 12250000 TM CVTDCB,EMVT MVT SYSTEM 12320000 BO LPABIT YES-SKIP TEST FOR MFT 12340000 TM CVTDCB,EMFT MFT SYSTEM 12360000 BZ OPNLIB NO-OPEN SYSLIB 12390000 OI CMLIBFLG,CQMFTLPA SET BIT FOR MFT LPA 12420000 LPABIT OI CMLIBFLG,CQLPASRH TURN ON LPA SEARCH BIT 12470000 * 12530000 *********************************************************************** 12600000 * 12670000 * INITIALIZE FOR CDE SEARCH 12740000 * 12810000 *********************************************************************** 12880000 * 12950000 LPALIB NI CMRELFLG,CQFF-CQLIB INDICATE LPA LIBRARY 13020000 LA WORKA,CMERCHN GET ADDR OF PTR TO ER CHAIN 13090000 ST WORKA,CMPREVPT SAVE AS PREVIOUS PTR 13160000 LA ADR,16 GET ADDR OF PTR TO CVT 13230000 L PTR,0(ADR) GET ADDR OF CVT 13300000 * 13370000 *********************************************************************** 13440000 * 13510000 * CONTENTS DIRECTORY ENTRY SEARCH 13580000 * 13650000 *********************************************************************** 13720000 * 13790000 USING CDENTRY,ADR 13860000 L ADR,CVTQLPAQ GET ADDR OF TOP OF CONTENTS 13930000 * DIRECTORY IN LPA QUEUE 14000000 LTR ADR,ADR QUEUE EMPTY 14070000 BZ OPNLIB YES-OPEN SYSLIB 14140000 GETNAME TM ESDTYPE(CESD),ENCAL+WEAKCALL NVCALL OR W-CON INC288 14220000 BC 5,CDEER YES. GET NEXT ER INC288 14230000 LM WORKA,WORKB,ESDNAME(CESD) GET NAME INTO TWO REGISTERS 14350000 CDECOMP1 C WORKA,CDNAME COMPARE FIRST HALF OF NAMES 14420000 BE CDECOMP2 EQUAL-COMPARE SECOND HALF 14490000 NOCOMP L ADR,CDCHAIN GET NEXT IN CHAIN 14560000 LA ADR,0(ADR) CLEAR HIGH BYTE 14630000 LTR ADR,ADR END OF CHAIN 14700000 BNE CDECOMP1 NO-COMPARE NAMES 14770000 CDEER ST CESD,CMPREVPT SAVE PREVIOUS POINTER 14840000 L CESD,ESDCHADR(CESD) GET NEXT ER 14910000 CDEER1 LTR CESD,CESD ANY LEFT 14980000 BZ BLDLER NO-SEE IF ALL ARE RESOLVED 15050000 L ADR,CVTQLPAQ GET ADDR OF FIRST CDE 15120000 DROP PTR 15190000 B GETNAME 15260000 CDECOMP2 C WORKB,CDNAME+4 COMPARE SECOND HALF OF NAME 15330000 BNE NOCOMP NOT EQUAL-CONTINUE SEARCH 15400000 * 15470000 *********************************************************************** 15540000 * 15610000 * CHANGE ENTRY TO SD 15680000 * 15750000 *********************************************************************** 15820000 * 15890000 L PARM,ESDRELCH(CESD) GET ADDR OF RLD CHAIN 15960000 LA PARM,0(PARM) CLEAR TYPE FIELD 16030000 TM CMLIBFLG,CQMFTLPA MFT LPA 16050000 BO MFTENTRY YES-GET ENTRY POINT 16070000 L CUM,CDENTPT GET ENTRY POINT ADDRESS 16100000 CLEARFLG LA CUM,0(CUM) CLEAR FLAG 16130000 ST CUM,ESDRELCH(CESD) PUT IN CESD ENTRY 16240000 L WORKA,ESDCHADR(CESD) GET PTR TO NEXT ER 16310000 ST WORKA,CMBLDLPT SAVE IT 16380000 L WORKB,CMPREVPT REMOVE MATCHED ER FROM CHAIN 16450000 ST WORKA,0(WORKB) 16520000 L WORKB,CMSDCHN PUT ON SD CHAIN 16590000 ST WORKB,0(CESD) 16660000 ST CESD,CMSDCHN 16730000 L BRANCH,MAPRTN GET ADDR OF MAP ROUTINE 16800000 BALR RETURN,BRANCH MAP ENTRY 16870000 L BRANCH,RLDRES RELOCATE RLD'S 16940000 BALR RETURN,BRANCH 17010000 L CESD,CMBLDLPT GET NEXT ER 17080000 B CDEER1 LOOK FOR MATCH 17150000 MFTENTRY L CUM,CDENTPT+4 GET ADDR OF ENTRY POINT 17170000 B CLEARFLG MAKE INTO SD ENTRY 17190000 BLDLER L CESD,CMERCHN GET ADDR OF FIRST ER 17220000 LTR CESD,CESD ANY ER'S 17290000 BZ COMMON NO-ASSIGN ADDR TO COMMON 17360000 DROP ADR 17430000 * 17500000 *********************************************************************** 17570000 * 17640000 * OPEN SYSLIB 17710000 * 17780000 *********************************************************************** 17850000 * 17920000 OPNLIB TM CMSTATUS,CQLIBOPN IS SYSLIB OPEN? 17950000 BO MOREER YES 17980000 L BRANCH,OPNSYSLI NO, GET ADDR OF OPEN RTN 18010000 BALR RETURN,BRANCH OPEN SYSLIB 18060000 TM CMSTATUS,CQLIBOPN SYSLIB OPEN 18130000 BZ COMMON NO-ASSIGN ADDRESSES TO COMMON 18200000 * 18270000 *********************************************************************** 18340000 * 18410000 * INITIAL BLDL LIST-GET START ADDRESS AND MAXIMUM 18480000 * NUMBER OF ENTRIES 18550000 * 18620000 *********************************************************************** 18690000 * 18760000 MOREER OI CMRELFLG,CQLIB INDICATE SYSLIB 18830000 L LNG,CMLOWTBL GET LOW TABLE ADDRESS 18900000 L PTR,CMNXTTXT GET HIGH TEXT ADDRESS 18970000 ST PTR,CMBLDLPT USE AS ADDR OF BLDL LIST 19040000 LA WORKA,EBLDLENT FOR INITIALIZING BLDL LIST 19110000 ST WORKA,0(PTR) INITIALIZE FIRST 2 HALF WORDS 19180000 * IN BLDL LIST TO 0 AND 26 19250000 LA PTR,EBLDLDIS(PTR) 19320000 SR LNG,PTR GET LENGTH OF BLDL LIST 19390000 SR ADR,ADR CLEAR EVEN REG FOR DIVIDE 19460000 LA WORKA,EBLDLSIZ BLDL ENTRY SIZE PLUS BLDL LIST 19530000 DR ADR,WORKA DIVIDE SIZE OF BLDL LIST AREA 19600000 * BY 20 TO GET NUMBER OF ENTRIES 19670000 LR ADR,PTR FOR ADDR OF LAST USED POSITION 19740000 * IN BLDL LIST 19810000 LR WORKB,PTR 19880000 LR ID,PTR 19950000 LA WORKA,EBLDLENT SIZE OF EACH ENTRY 20020000 SR CUM,CUM CLEAR-NUM OF ENTRIES 20090000 L CESD,CMERCHN 20160000 * 20230000 *********************************************************************** 20300000 * 20370000 * SET UP BLDL LIST 20440000 * 20510000 *********************************************************************** 20580000 * 20650000 ENDCH LTR CESD,CESD END OF ER CHAIN 20720000 BE ANYENT YES-SEE IF ANY ENTRIES IN BLDL 20790000 TM ESDTYPE(CESD),EBLDLATT HAS BLDL BEEN ATTEMPTED 20860000 BZ MNCAL NO-SEE IF MARKED NCAL 20930000 NXTER L CESD,ESDCHADR(CESD) GET PTR TO NEXT ER 21000000 B ENDCH SEE IF END OF CHAIN 21070000 MNCAL TM ESDTYPE(CESD),ENCAL+WEAKCALL NVCALL OR W-CON INC288 21150000 BC 5,NXTER YES. GET NEXT ER INC288 21160000 TM ESDRELOC(CESD),X'80' SPECIAL DELETE BIT ON? SA70542 21210021 BO NXTER YES, DONT RESOLVE SA70542 21260021 OI ESDTYPE(CESD),EBLDLATT TURN ON BLDL ATTEMPTED BIT 21280000 LTR CUM,CUM FIRST ENTRY 21350000 BNZ LASTENTR 21420000 LTR LNG,LNG MAXIMUM NUM ENTRIES ZERO 21490000 BNZ ENTER1 NO-MOVE NAME INTO BLDL LIST 21560000 * 21630000 *********************************************************************** 21700000 * 21770000 * PRINT ERROR MESSAGE-PROGRAM TOO LARGE 21840000 * 21910000 *********************************************************************** 21980000 * 22050000 TOOBIG LA ZERO,ERSIZE2 GET ERROR CODE FOR BIT MAP 22120000 L BRANCH,LOGRTN GET ADDR OF ERROR LOG RTN 22190000 BR BRANCH LOG ERROR MESSAGE 22260000 * 22330000 *********************************************************************** 22400000 * 22470000 * PUT NAMES IN ALPHABETICAL ORDER 22540000 * 22610000 *********************************************************************** 22680000 * 22750000 ANYENT LTR CUM,CUM ANY ENTRIES IN BLDL LIST 22820000 BZ COMMON NO-ASSIGN ADDR TO COMMON 22890000 B MOVEADR 22960000 LASTENTR LA ID,EBLDLENT(ID) 23030000 COMPNAME CLC ESDNAME(8,CESD),0(PTR) COMPARE THIS NAME TO PREVIOUS 23100000 * NAME IN LIST 23170000 BNL ENTER LOW OR EQUAL MOVE NAME TO LIST 23240000 LA ADR,EBLDLENT(PTR) GET ADDR OF NEXT POSITION 23310000 * IN BLDL LIST 23380000 MVC 0(12,ADR),0(PTR) MOVE PREVIOUS NAME DOWN ONE 23450000 * POSITION 23520000 CR PTR,WORKB PTR AT FIRST ENTRY 23590000 BE ENTER1 23660000 SR PTR,WORKA SET PTR BACK ONE ENTRY 23730000 B COMPNAME 23800000 ENTER LA PTR,EBLDLENT(PTR) GET ADDR OF NEXT POSITION 23870000 ENTER1 MVC 0(8,PTR),ESDNAME(CESD) MOVE NAME INTO BLDL LIST 23940000 ST CESD,8(PTR) PUT ADDR OF CESD ENTRY NEXT 24010000 * TO NAME 24080000 LA CUM,1(CUM) UPDATE NUMBER OF ENTRIES 24150000 LR PTR,ID 24220000 CR CUM,LNG NUMBER OF ENTRIES EQUAL MAX 24290000 BNE NXTER NO-GET NEXT ER 24360000 * 24430000 *********************************************************************** 24500000 * 24570000 * PUT ADDRESSES OF CESD ENTRIES IN ADDRESS LIST 24640000 * 24710000 *********************************************************************** 24780000 * 24850000 MOVEADR LR ADR,WORKB ADDR OF FIRST BLDL ENTRY 24920000 LA PTR,EBLDLENT(ID) ADDR OF FIRST ADR LIST ENTRY 24990000 LR WORKA,PTR SAVE ADDRESS 25060000 L WORKB,CMBLDLPT GET ADDR OF BLDL LIST 25130000 STH CUM,0(WORKB) PUT IN NUMBER OF ENTRIES 25200000 LR LNG,CUM NUMBER OF ENTRIES IN LIST 25270000 LR ID,ADR SAVE FIRST ENTRY ADDRESS 25340000 ADRLIST MVC 0(4,PTR),8(ADR) MOVE CESD ADDR FROM BLDL LIST 25410000 LA ADR,EBLDLENT(ADR) GET ADDR OF NEXT ENTRY 25480000 LA PTR,EADRLENT(PTR) 25550000 BCT LNG,ADRLIST BRANCH UNTIL NO MORE ENTRIES 25620000 * 25690000 *********************************************************************** 25760000 * 25830000 * ISSUE BLDL MACRO 25900000 * 25970000 *********************************************************************** 26040000 * 26110000 DOBLDL L PARM,CMRDCBPT GET ADDR OF SYSLIB DCB 26180000 L ZERO,CMBLDLPT GET ADDR OF BLDL LIST 26250000 BLDL (1),(0) 26320000 LA WORKB,EBLDLRC GET RETURN CODE FOR BLDL ERR 26390000 CR BRANCH,WORKB BLDL ERROR? 26460000 BNE MOVETTR NO-CONTINUE 26530000 LA ZERO,ERIOUT4 GET ERROR CODE FOR BLDL ERROR 26600000 L BRANCH,LOGRTN GET ADDR OF ERROR LOG RTN 26670000 BALR RETURN,BRANCH LOG ERROR 26740000 B COMMON ASSIGN ADDR TO COMMON 26810000 * 26880000 *********************************************************************** 26950000 * 27020000 * PUT TTR'S IN CESD ENTRIES 27090000 * 27160000 *********************************************************************** 27230000 * 27300000 MOVETTR LR PTR,WORKA GET ADDR OF FIRST ENTRY IN 27370000 * ADDRESS LIST 27440000 LR ADR,ID GET ADDR FIRST BLDL ENTRY 27510000 HAVETTR CLI EBLDLR(ADR),X'00' THIS ENTRY NOT FOUND-R=0 27580000 BE NXTENT YES-GET NEXT ENTRY 27650000 L WORKB,0(PTR) GET ADDR OF CESD ENTRY 27720000 MVC ESDRELOC(4,WORKB),EBLDLTTR(ADR) MOVE TTR TO CESD 27790000 OI ESDTYPE(WORKB),ETTR MARK CESD ENTRY TTR 27860000 NXTENT LA ADR,EBLDLENT(ADR) INCREMENT BLDL LIST POINTER 27930000 LA PTR,EADRLENT(PTR) INCREMENT ADDRESS LIST POINTER 28000000 BCT CUM,HAVETTR PROCESS ALL ENTRIES 28070000 L CESD,CMERCHN PICK UP ER CHAIN PTR 28140000 NEXT LTR CESD,CESD END OF CHAIN 28210000 BZ TESTLIB YES-ANY MORE ER'S 28280000 TM ESDTYPE(CESD),ETTR THIS ENTRY HAVE TTR 28350000 BO DOFIND YES-ISSUE FIND MACRO 28420000 NEXT1 L CESD,ESDCHADR(CESD) PICK UP PTR TO NEXT ER 28490000 B NEXT 28560000 * 28630000 *********************************************************************** 28700000 * 28770000 * ISSUE FIND MACRO 28840000 * 28910000 *********************************************************************** 28980000 * 29050000 DOFIND NI ESDTYPE(CESD),CQFF-ETTR TURN OFF TTR RECEIVED BIT 29120000 LA WORKA,ESDRELOC(CESD) GET ADDR OF TTR FOR FIND 29190000 L ADR,CMRDCBPT GET ADDR OF SYSLIB DCB 29260000 FIND (ADR),(WORKA),C 29330000 NI CMIOFLGS,CQFF-CQEOCB-CQEOFB-CQEOFSB-CQIGNCR 29400000 * INITIALIZE EOF BITS 29470000 TM CMIOFLGS,CQRECFM LOAD MODULE-CHECK RECFM IN DCB 29540000 BZ OBJECT NO-PRIME OBJ MOD BUFFERS 29610000 L BRANCH,LOADRTN GET ADDR OF LOAD MOD PROC 29680000 BALR RETURN,BRANCH PROCESS LOAD MODULE 29750000 TESTCC L CESD,CMERCHN 29820000 B NEXT 29890000 OBJECT L BRANCH,PRIMRTN GET ADDR OF PRIME ROUTINE 29960000 BALR RETURN,BRANCH GO PRIME OBJ MOD BUFFERS 30030000 L BRANCH,RELORTN GET ADDR OF OBJ MOD PROCESSOR 30100000 BALR RETURN,BRANCH GO PROCESS OBJ MODULE 30170000 B TESTCC 30240000 * 30310000 *********************************************************************** 30380000 * 30450000 * CHECK FOR MORE ER'S AND WHICH LIBRARY TO SEARCH 30520000 * 30590000 *********************************************************************** 30660000 * 30730000 TESTLIB L CESD,CMERCHN GET ADDR OF FIRST ER 30800000 LTR CESD,CESD CHAIN EMPTY 30870000 BZ COMMON YES-ASSIGN ADDR TO COMMON 30940000 TM CMLIBFLG,CQLPASRH RESIDENT LIBRARY 31010000 BO LPALIB YES-SEARCH LPA AREA 31080000 B MOREER NO-ISSUE BLDL 31150000 *********************************************************************** 31220000 * 31290000 * ASSIGN ADDRESSES TO COMMON 31360000 * 31430000 *********************************************************************** 31500000 * 31570000 COMMON NI CMLIBFLG,CQFF-CQAUTOC TURN OFF AUTOCALL BIT 31640000 L CESD,CMCMCHN PICK UP PTR TO COMMON CHAIN 31710000 MVC CMTOPCOD(4),CMNXTTXT SAVE TOP OF CODE WHICH CAN'T BE 31730000 * OVERLAID. 31750000 COMMON1 LTR CESD,CESD END OF CHAIN 31780000 BZ PSEUDOR YES-ASSIGN DISPLACEMENTS TO PR 31850000 L PARM,ESDRELCH(CESD) GET ADDR OF ER CHAIN FOR RELOC 31920000 LA PARM,0(PARM) CLEAR TYPE FIELD 31990000 IC WORKB,ESDTYPE(CESD) SAVE TYPE FIELD 32060000 L PTR,ESDCMCHN(CESD) PICK UP PTR TO CHAINED CM ENTRY 32130000 L ADR,CMNXTTXT GET NEXT TXT ADDRESS 32200000 OI CMFLAG4,CQCOMMON SHOW COMMON RECEIVED 32210000 LA ADR,7(ADR) ROUND IT TO DOUBLEWORD BOUNDARY 32270000 * ADD SEVEN 32340000 ST ADR,ESDRELCH(CESD) PLACE IN ESD ENTRY 32410000 NI ESDRELCH+3(CESD),X'F8' AND OFF 3 LOW ORDER BITS 32480000 L ADR,ESDRELCH(CESD) GET ROUNDED OFF ADDRESS 32550000 ST ADR,ESDCMCHN(CESD) 32620000 STC WORKB,ESDTYPE(CESD) RESTORE TYPE 32690000 L WORKA,ESDLNG(PTR) GET LENGTH OF COMMON 32760000 LA WORKA,0(WORKA) 32830000 AR ADR,WORKA ADD LENGTH OF COMMON TO ADDR 32900000 C ADR,CMHITBL LESS THAN HIGH TABLE 32970000 BNL TOOBIG NOT LOW-TERMINATE 33040000 ST ADR,CMNXTTXT UPDATE NEXT TXT ADDR 33110000 L BRANCH,MAPRTN GET ADDR OF MAP ROUTINE 33180000 BALR RETURN,BRANCH MAP ENTRY 33250000 L BRANCH,RLDRES GET ADDR OF RLD RESOLUTION RTN 33320000 BALR RETURN,BRANCH RESOLVE RLD'S 33390000 L CESD,ESDCHADR(CESD) PICK UP NEXT PTR IN CHAIN 33460000 B COMMON1 33530000 * 33600000 *********************************************************************** 33670000 * 33740000 * ASSIGN DISPLACEMENTS TO PSEUDO REGISTERS 33810000 * 33880000 *********************************************************************** 33950000 * 34020000 PSEUDOR SR CUM,CUM ZERO LOCATION CTR FOR PR'S 34090000 LH WORKB,CMWTBFCT PICK UP COUNT IN BUFFER 34160000 LTR WORKB,WORKB IS COUNT ZERO 34230000 BZ PSEUDOR1 YES-DON'T CLEAR BUFFER 34300000 L BRANCH,PRTRTN GET ADDR OF IEWLPRNT 34370000 BALR RETURN,BRANCH PURGE RRINT BUFFER 34440000 PSEUDOR1 L CESD,CMPRCHN PICK UP ADDR OF PR CHAIN 34510000 LTR CESD,CESD END OF CHAIN 34580000 BZ FINISHUP SKIP THIS ROUTINE 34650000 MVI CMPRTCTL,CTSPACE2 SET UP CARRIAGE CONTROL 34720000 PRC2 SR WORKA,WORKA CLEAR REGISTER 34790000 SR LNG,LNG 34860000 BCTR WORKA,0 SET TO ALL FF'S 34930000 IC LNG,ESDPRALN(CESD) PICK UP ALIGNMENT FACTOR 35000000 SR WORKA,LNG SUBTRACT ALIGN FACTOR FROM FF'S 35070000 AR CUM,LNG ADD ALIGNMENT FACTOR TO PR 35140000 * LOCATION COUNTER 35210000 NR CUM,WORKA AND SUM WITH F'S-ALIGNMENT 35280000 * VALUE EQUAL ASSIGNED ADDRESS 35350000 IC WORKB,ESDTYPE(CESD) SAVE TYPE FIELD 35420000 L PARM,ESDTYPE(CESD) GET ADDR OF RLD'S FOR RELOC 35490000 LA PARM,0(PARM) CLEAR HIGH BYTE 35560000 ST CUM,ESDTYPE(CESD) PUT ASSIGN ADDR IN CESD 35630000 STC WORKB,ESDTYPE(CESD) RESTORE TYPE 35700000 L WORKA,ESDLNG(CESD) GET LENGTH OF PR 35770000 LA WORKA,0(WORKA) CLEAR HIGH BYTE 35840000 AR CUM,WORKA ADD LENGTH TO PR LOCATION CTR 35910000 L BRANCH,MAPRTN GET ADDR OF MAP ROUTINE 35980000 BALR RETURN,BRANCH MAP CESD ENTRY 36050000 L BRANCH,RLDRES GET ADDR OF RLD RESOLUTION RTN 36120000 BALR RETURN,BRANCH 36190000 L CESD,ESDCHADR(CESD) GET PTR TO NEXT PR 36260000 LTR CESD,CESD END OF CHAIN 36330000 BNZ PRC2 36400000 PRA4 L BRANCH,PRTRTN GET ADDR OF IEWLPRNT(PRINT RTN) 36470000 BALR RETURN,BRANCH FLUSH LAST MAP LINE 36540000 PRA5 MVI CMPRTCTL,CTSPACE2 SET UP CARRIAGE CONTROL 36610000 L ADR,CMCXDPT GET ADDR OF LOCATION REQUESTING 36680000 * CUMULATIVE LENGTH 36750000 NEXTCXD1 LTR ADR,ADR ZERO IF NCAL SPECIFIED 36820000 BZ FINISHUP SKIP FILLING IN LENGTH FOR CXD 36890000 NEXTCXD L WORKA,ECXDADR(ADR) GET ADDR OF LOCATION REQUESTING 36960000 ST CUM,0(WORKA) PUT TOTAL LENGTH AT THAT LOC 37030000 L ADR,0(ADR) GET ADDR OF NEXT LOC 37100000 B NEXTCXD1 CHECK FOR NEXT CXD 37170000 * 37240000 *********************************************************************** 37310000 * 37380000 * ISSUE UNRESOLVED ER MESSAGES 37450000 * 37520000 *********************************************************************** 37590000 * 37660000 FINISHUP L CESD,CMERCHN GET ADDR OF ER CHAIN 37730000 DEB2 LTR CESD,CESD END OF CHAIN 37800000 BZ NOTXT 37870000 TM ESDRELOC(CESD),X'80' SPECIAL DELETE BIT ON? SA70542 37920021 BO DEF2 YES, NO MESSAGE SA70542 37930021 TM CMPRMFLG,CQCALL AUTOCALL SPECIFIED 37940000 BZ DED2 NO-ISSUE WARNING MESSAGES 38010000 TM ESDTYPE(CESD),ENCAL MARKED NEVER CALL 38080000 BO DED2 YES-WARNING MESSAGE 38150000 TM ESDTYPE(CESD),WEAKCALL IS IT MARKED W-CON INC288 38160000 BO DEF2 YES. GET NEXT ER INC288 38170000 LA ZERO,ERRELO2 GET ERROR CODE FOR ERROR MSG 38220000 B DEE2 38290000 NOTXT TM CMLIBFLG,CQNOTXT SEE IF ANY TXT RECEIVED 38360000 BO DEA4 YES-FIND ENTRY PT 38430000 LA ZERO,ERINPT3 GET ERROR CODE FOR NO TEXT 38500000 L BRANCH,LOGRTN GET ADDR OF ERROR LOG RTN 38570000 BALR RETURN,BRANCH LOG ERROR MESSAGE 38640000 B BADCC QUIT 38710000 DED2 LA ZERO,ERRELO1 GET ERROR CODE FOR WARNING MSG 38780000 DEE2 LA PARM,ESDNAME(CESD) 38850000 L BRANCH,LOGRTN GET ADDR OF LOG ROUTINE 38920000 BALR RETURN,BRANCH LOG ERROR MESSAGE 38990000 DEF2 L CESD,ESDCHADR(CESD) GET ADDR OF NEXT ER IN CHAIN 39060000 B DEB2 39130000 * 39200000 *********************************************************************** 39270000 * 39340000 * FIND ENTRY POINT ADDRESS 39410000 * 39480000 *********************************************************************** 39550000 * 39620000 DEA4 TM CMPRMFLG,CQEPNAME+CQEPADDR ENTRY POINT NAME AND ADDRESS 39690000 * RECEIVED 39760000 BO DEB3 YES-ENTRY ADDR ALREADY SET 39830000 BZ USETXT NEITHER-USE FIRST TXT ADDR 39900000 TM CMPRMFLG,CQEPNAME ENTRY POINT NAME RECEIVED 39970000 BO USETXT1 YES-USE FIRST TXT 40040000 L CESD,CMEPCESD GET ADDR OF EP CESD 40110000 TM ESDTYPE(CESD),ERTYPE EP AN ER? 40180000 BO USETXT2 40250000 B DEB3 40320000 USETXT LA ZERO,ERENTR1 ERROR CODE FOR NEITHER EP NAME 40390000 * OR EP ADDR RECEIVED 40460000 B ERRO 40530000 USETXT1 LA ZERO,ERENTR2 ERROR CODE FOR EP NAME NOT 40600000 * FOUND 40670000 LA PARM,CMEPNAME PRINT NAME RECEIVED 40740000 ERRO L BRANCH,LOGRTN 40810000 BALR RETURN,BRANCH 40880000 USETXT2 LH WORKA,CMNUMXS GET NUMBER OF EXTENTS 40900000 LTR WORKA,WORKA ANY PRELOADED TEXT 40920000 BNZ DEB3 YES. LEAVE EP ADDR 40940000 MVC CMEPADDR(4),CMBEGADR UES FIRST TEXT AS EP. 40960000 DEB3 L PARM,CMNXTTXT GET ADDR OF NXT FREE TXT 41020000 S PARM,CMBEGADR SUBTRACT ADDR OF BEGINNING OF 41090000 * TXT FROM ADDR OF END OF TXT 41160000 L WORKA,CMXLCHN GET EXTENT CHAIN 41168000 LEN1 LTR WORKA,WORKA ANY PRE-LOADED TEXT 41176000 BZ LEN2 NO. BRANCH 41184000 A PARM,8(WORKA) YES. ADD LENGTH OF EXTENT 41192000 L WORKA,0(WORKA) GET NEXT EXTENT IN CHAIN 41200000 B LEN1 LOOP BACK 41208000 LEN2 EQU * 41216000 ST BASE,CMBLDLPT SAVE BASE REGISTER 41230000 L BRANCH,CNVTRTN GET ADDR OF CONVERT ROUTINE 41300000 BALR RETURN,BRANCH CONVERT LENGTH TO PRINTABLE HEX 41370000 L BASE,CMBLDLPT RESTORE BASE REGISTER 41440000 L ADR,CMPUTREC GET ADDR OF PRINT BUFFER 41510000 MVC 3(MSG2LNG,ADR),MSG2 TOTAL LENGTH 41580000 MVC 5+MSG2LNG(7,ADR),CMXDBLWD MOVE IN LENGTH 41650000 MVI CMPRTCTL,CTSPACE2 SET UP CARRIAGE CONTROL 41720000 L BRANCH,PRTRTN GET ADDR OF PRINT ROUTINE 41790000 BALR RETURN,BRANCH 41860000 L PARM,CMEPADDR GET ENTRY POINT ADDR 41930000 ST BASE,CMBLDLPT SAVE BASE REGISTER 42000000 L BRANCH,CNVTRTN 42070000 BALR RETURN,BRANCH 42140000 L BASE,CMBLDLPT RESTORE BASE REGISTER 42210000 L ADR,CMPUTREC GET ADDR OF PRINT BUFFER 42280000 MVC 3(MSG3LNG,ADR),MSG3 ENTRY ADDRESS 42350000 MVC 4+MSG3LNG(7,ADR),CMXDBLWD MOVE IN ADDRESS 42420000 L BRANCH,PRTRTN 42490000 BALR RETURN,BRANCH 42560000 B BADCC1 42630000 DROP BASE 42700000 EJECT 42770000 * 42840000 *********************************************************************** 42910000 * 42980000 * LOAD MODULE PROCESSOR 43050000 * 43120000 *********************************************************************** 43190000 * 43260000 USING *,BRANCH 43330000 IEWLODE SAVE (14,12),T,* SAVE CALLERS REGISTERS 43400000 L BASE,AUTOCALL 43470000 DROP 15 43540000 USING IEWACALL,BASE 43610000 L SAVEREG,8(SAVEREG) NEW SAVE AREA ADDRESS 43680000 NI CMLIBFLG,CQFF-CQFIRST INITIALIZE FLAGE 43750000 * 43820000 *********************************************************************** 43890000 * 43960000 * READ CONTROL RECORD 44030000 * 44100000 *********************************************************************** 44170000 * 44240000 RDCNTRL SR ZERO,ZERO INDICATE READ CONTROL RECORD 44310000 L BRANCH,READRTN GET ADDRESS OF READ ROUTINE 44380000 BALR RETURN,BRANCH GO TO READ 44450000 RDCNTRL1 TM CMIOFLGS,CQEOCB END OF CONCATENATION 44520000 BO PROCEOM YES-PROCESS END OF MODULE 44590000 IGN NI CMLIBFLG,CQFF-CQDELETE-CQKEEPS 44660000 TM CMIOFLGS,CQIGNCR IGNORE CONTROL REC BIT ON 44730000 BO RDCNTRL YES-READ ANOTHER RECORD 44800000 L ADR,CMGETREC GET ADDR OF INPUT BUFFER 44870000 USING DCNTRLB,ADR ESTABLISH DSECT ADDRESS 44940000 TM DTYPE,ESYMSCAT REC TYPE SYM OR SCAT/TRAN 45010000 BM RDCNTRL YES-IGNORE-READ ANOTHER REC 45080000 TM DTYPE,ECESD RECORD TYPE CESD 45150000 BZ FINCESD1 NO-FINISH PROCESSING CESD 45220000 OI CMLIBFLG,CQFIRST FIRST REC IS CESD 45290000 OI CMLIBFLG,CQCESDR TURN ON CESD RECEIVED BIT 45360000 LH ID,DESID GET ID OF FIRST ITEM 45430000 LH LNG,DCOUNT GET COUNT OF ESD DATA 45500000 LA PTR,DESDDATA GET ADDR OF START OF DATA 45570000 L BRANCH,CESDRTN GET ADDR OF ESD PROCESSOR 45640000 BALR RETURN,BRANCH PROCESS ESD'S 45710000 B RDCNTRL READ ANOTHER CONTROL RECORD 45780000 * 45850000 *********************************************************************** 45920000 * 45990000 * PROCESS CESD 46060000 * 46130000 *********************************************************************** 46200000 * 46270000 FINCESD1 TM CMLIBFLG,CQFIRST WAS FIRST REC CESD 46340000 BO FINCESD YES-CONTINUE 46410000 LA ZERO,ERINPT6 SET ERROR CODE-INVALID INPUT 46480000 L BRANCH,LOGRTN GET ADDR OF LOG ROUTINE 46550000 BALR RETURN,BRANCH LOG ERROR 46620000 B BADCC1 RETURN 46690000 FINCESD TM CMLIBFLG,CQCESDR TEST CESD RECEIVED ON 46760000 BZ PROCRAT NO-PROCESS RLD'S AND TXT 46830000 NI CMLIBFLG,CQFF-CQCESDR TURN OFF CESD RECEIVED BIT 46900000 L BRANCH,CESDRTN GET ADDR OF ESD PROCESSOR 46970000 BALR RETURN,BRANCH FINISH PROCESSING CESD 47040000 PROCRAT TM DTYPE,ERLD RECORD TYPE RLD 47110000 BZ PROCTXT NO-PROCESS TXT 47180000 LH LNG,DRLDCNT COUNT OF RLD DATA 47250000 LA PTR,DRLDDATA GET ADDR OF START OF RLD DATA 47320000 L BRANCH,RLDRTN GET ADDR OF RLD PROCESSOR RTN 47390000 BALR RETURN,BRANCH PROCESS RLD'S 47460000 TM DTYPE,ETXT ALSO TXT CONTROL RECORD 47530000 BO LMTXT YES-GO TO LOAD MOD TXT PROCESS 47600000 TM DTYPE,ELAST LAST RECORD BIT ON 47670000 BZ RDCNTRL NO-READ ANOTHER CONTROL RECORD 47740000 TM CMLIBFLG,CQAUTOC AUTOCALL BIT ON 47810000 BO PROCEOM GO TO EOM PROCESSOR 47880000 OI CMIOFLGS,CQIGNCR SET IGNORE CONTROL REC BIT ON 47950000 B RDCNTRL READ ANOTHER RECORD 48020000 PROCTXT TM DTYPE,ETXT TXT CONTROL RECORD 48090000 BO LMTXT GO TO LOAD MOD TXT PROCESSOR 48160000 LA ZERO,ERINPT6 SET ERROR CODE-INVALID INPUT 48230000 * FROM LOAD MODULE 48300000 L BRANCH,LOGRTN GET ADDR OF LOG ROUTINE 48370000 BALR RETURN,BRANCH GO TO LOG ERROR MESSAGE 48440000 B RDCNTRL READ ANOTHER RECORD 48510000 * 48580000 *********************************************************************** 48650000 * 48720000 * PROCESS END OF MODULES 48790000 * 48860000 *********************************************************************** 48930000 * 49000000 PROCEOM L BRANCH,EOMRTN GET ADDR OF END OF MODULE PROC 49070000 BALR RETURN,BRANCH GO PROCESS END OF MODULE 49140000 * 49210000 *********************************************************************** 49280000 * 49350000 * ISSUE RETURN MACRO 49420000 * 49490000 *********************************************************************** 49560000 * 49630000 BADCC NI CMIOFLGS,CQFF-CQIGNCR SET IGNORE CONTROL REC OFF 49700000 BADCC1 L SAVEREG,4(SAVEREG) PICT UP PTR TO CALLER'S SAVE 49770000 RETURN (14,12),T RESTORE REGISTERS AND RETURN 49840000 * 49910000 *********************************************************************** 49980000 * 50050000 * PROCESS ID/LENGTH LIST 50120000 * 50190000 *********************************************************************** 50260000 * 50330000 LMTXT SR CUM,CUM CLEAR CUMULATING REGISTER 50400000 LA PTR,DID GET ADDRESS OF ID/LENGTH LIST 50470000 LH ZERO,DRLDCNT LENGTH OF RLD ITEMS 50540000 AR PTR,ZERO ADD TO START OF DATA 50610000 ST PTR,CMBLDLPT SAVE START ADDR OF ID/LENGTH 50680000 LH LNG,DCNTIDLN GET LENGTH OF ID/LENGTH LIST 50750000 LA WORKB,EIDLNG GET LENGTH OF EACH ENTRY 50820000 LNR WORKB,WORKB MAKE NEG FOR DECREMENT 50890000 PICKID BXLE LNG,WORKB,FINIDL 50960000 LH ID,0(PTR) 51030000 L BRANCH,RENUMID GET ADDRESS OF TRANSID 51100000 BALR RETURN,BRANCH GO GET ADDR OF RNT ENTRY 51170000 LTR PARM,PARM ENTRY EXISTS IF NOT ZERO 51240000 BZ SKIPREC IF ZERO-SKIP THIS RECORD 51310000 B MARKDEL SEE IF MARKED DELETE 51380000 DELETE OI CMLIBFLG,CQDELETE TURN ON DELETE BIT 51450000 AH CUM,ELENGTH(PTR) ADD LENGTH TO CUM REGISTER 51520000 B NEXTID GET NEXT ID 51590000 MARKDEL TM ESDTYPE(CESD),EDELETE ENTRY MARKED DELETE 51660000 BO DELETE YES-SET DELETE BIT 51730000 TM CMLIBFLG,CQKEEPS FIRST 'KEEP' ID 51800000 BO NOTFIRST NO-CONTINUE 51870000 L WORKA,ESDRELOC(CESD) GET RELATIVE RELOC CONSTANT 51940000 AR WORKA,CUM ADD AMOUNT DELETED FROM FRONT 52010000 OI CMLIBFLG,CQNOTXT+CQKEEPS TXT HAS BEEN RECEIVED 52080000 NOTFIRST SR CUM,CUM CLEAR CUMULATING REGISTER 52150000 L ID,ESDLAA(CESD) GET LAST CSECT ADDR 52220000 LA ID,0(ID) CLEAR FLAG BYTE 52290000 AH ID,ELENGTH(PTR) ADD LENGTH OF CSECT 52360000 ST ID,CMLSTTXT SAVE AS LAST TEXT ADDR 52430000 NEXTID LA PTR,EIDLNG(PTR) GET ADDR OF NEXT ENTRY IN 52500000 * ID/LENGTH LIST 52570000 B PICKID 52640000 FINIDL TM CMLIBFLG,CQKEEPS KEEP SOME BIT ON 52710000 BO RDSETUP GET INFORMATION FOR TXT READ 52780000 * 52850000 *********************************************************************** 52920000 * 52990000 * SKIP TXT RECORD 53060000 * 53130000 *********************************************************************** 53200000 * 53270000 SKIPREC LA ZERO,1 INDICATE SKIP RECORD 53340000 LNR ZERO,ZERO 53410000 L PARM,CMGETREC REG1 HAS ADDRESS OF RLD BUF 53480000 B LASTXT SEE IF LAST TXT REC IN MODULE 53550000 * 53620000 *********************************************************************** 53690000 * 53760000 * READ TXT 53830000 * 53900000 *********************************************************************** 53970000 * 54040000 RDSETUP LR PARM,WORKA GET ADDR FOR TEXT READ 54110000 MVI DADDR,X'00' GET RID OF CCW OP CODE 54180000 A PARM,DADDR ADD ADDR FROM CONTROL REC 54250000 L ZERO,DCCOUNT GET COUNT FROM CONTROL REC 54320000 N ZERO,COUNTAND CLEAR TOP HALF WORD 54390000 SR ZERO,CUM SUBTRACT CUMULATING REGISTER 54460000 * FROM COUNT-AMOUNT DELETED 54530000 * FROM END 54600000 LR WORKA,PARM GET ADDR IN ANOTHER REG 54670000 AR WORKA,ZERO ADD COUNT TO ADDR 54740000 C WORKA,CMLOWTBL SUM EXCEED LOW TABLE ADDR 54810000 BNH LASTXT NO-SEE IF LAST TXT REC 54880000 B TOOBIG PRINT ERROR MESSAGE 54950000 LASTXT TM DTYPE,ELTXT TXT REC LAST IN MODULE 55020000 BZ IDDEL 55090000 TM CMLIBFLG,CQAUTOC AUTOCALL BIT ON 55160000 BO LMRDTXT YES-READ ONLY TEXT 55230000 OI CMIOFLGS,CQIGNCR SET IGNORE CONTROL REC BIT ON 55300000 IDDEL TM CMLIBFLG,CQDELETE ANY ID'S TO BE DELETED 55370000 BO LMRDTXT YES-READ ONLY TEXT 55440000 RDTAC LNR ZERO,ZERO INDICATE READ TXT AND CONTROL 55510000 * MAKE REG0 NEGATIVE 55580000 LMRDTXT L BRANCH,READRTN GET ADDRESS OF READ ROUTINE 55650000 BALR RETURN,BRANCH GO TO READ 55720000 TM CMIOFLGS,CQEOCB END OF CONCATENATION 55790000 BZ ANYDEL NO-ANY TXT TO BE DELETED 55860000 TM CMIOFLGS,CQEOFSB END OF FILE ON FIRST READ 55930000 BZ ANYDEL NO-ANY TXT TO BE DELETED 56000000 NI CMLIBFLG,CQFF-CQDELETE-CQKEEPS CLEAR DELETE AND KEEP 56070000 * SOME BITS 56140000 LA ZERO,ERINPT6 INVALID INPUT FROM LOAD MOD 56210000 * TEXT RECORD EXPECTED-NOT REC 56280000 L BRANCH,LOGRTN GET ADDR OF LOG ROUTINE 56350000 BALR RETURN,BRANCH GO TO LOG ERROR MESSAGE 56420000 B PROCEOM GO TO PROCESS END OF MOD 56490000 ANYDEL TM CMLIBFLG,CQDELETE ANY TEXT TO BE DELETED 56560000 BO ALLDEL YES-ALL TO BE DELETED 56630000 DELALL LTR ZERO,ZERO CONTROL REC READ 56700000 * REG0 LESS THAN ZERO 56770000 BNL PROCEOM NO-GO TO PROCESS EOM 56840000 B RDCNTRL1 56910000 * 56980000 *********************************************************************** 57050000 * 57120000 * DELETE SOME TXT 57190000 * 57260000 *********************************************************************** 57330000 * 57400000 ALLDEL NI CMLIBFLG,CQFF-CQDELETE TURN OFF DELETE TXT BIT 57470000 TM CMLIBFLG,CQKEEPS ALL TXT TO BE DELETED 57540000 BZ DELALL YES-DELETE ALL 57610000 NI CMLIBFLG,CQFF-CQKEEPS TURN OFF KEEP SOME BIT 57680000 LR WORKA,PARM GET ADDR OF FIRST TXT READ 57750000 L PTR,CMBLDLPT RESTORE PTR TO FIRST ID 57820000 LH LNG,DCNTIDLN GET LENGTH OF ID/LENGTH LIST 57890000 LA WORKB,EIDLNG GET LENGTH OF EACH ENTRY 57960000 LNR WORKB,WORKB MAKE NEGATIVE FOR DECREMENT 58030000 * 58100000 *********************************************************************** 58170000 * 58240000 * MOVE TXT TO CORRECT LOCATION 58310000 * 58380000 *********************************************************************** 58450000 * 58520000 GETID BXLE LNG,WORKB,RDCNTRL 58590000 LH ID,0(PTR) 58660000 LH CUM,ELENGTH(PTR) GET LENGTH OF CSECT 58730000 L BRANCH,RENUMID GET ADDR OF TRANSID 58800000 BALR RETURN,BRANCH GET ADDR OF RNT ENTRY 58870000 TM ESDTYPE(CESD),EDELETE THIS ENTRY MARKED DELETE 58940000 BO GETNXT YES-GET NEXT ID 59010000 L PARM,ESDLAA(CESD) GET ADDR OF THIS ID FROM CESD 59080000 CR WORKA,PARM TXT IN RIGHT PLACE 59150000 BE GETNXT YES-GET NEXT ID 59220000 LA ZERO,256 GET CONSTANT 256 FOR TEST 59290000 MOVELOOP CR CUM,ZERO LENGTH GREATER THAN 256 59360000 BNH MOVELESS NO-MOVE REMAINING BYTES 59430000 MVC 0(256,PARM),0(WORKA) MOVE 256 CHARACTERS 59500000 AR WORKA,ZERO INCREMENT MOVE ADDRESSES 59570000 AR PARM,ZERO 59640000 SR CUM,ZERO DECREMENT LENGTH 59710000 B MOVELOOP COMPARE-STILL GREATER THAN 256 59780000 LASTMOVE MVC 0(1,PARM),0(WORKA) MOVE FOR LESS THAN 256 59850000 MOVELESS BCTR CUM,0 DECREMENT MOVE FOR EXECUTE MVC 59920000 EX CUM,LASTMOVE MOVE LAST TXT 59990000 LA CUM,1(CUM) GET BACK TO CORRECT LENGTH 60060000 GETNXT AR WORKA,CUM POINT TO NEXT CESECT 60130000 LA PTR,EIDLNG(PTR) GET ADDR OF NEXT ENTRY IN 60200000 * ID/LENGTH LIST 60270000 B GETID 60340000 EJECT 60410000 *********************************************************************** 60480000 * ERROR LOG ROUTINE --- THIS ROUTINE FORMATS AND PRINTS ERROR 60550000 * MESSAGE ON THE SYSPRINT AND SYSTERM DATA SETS.IF A SEV 4 ERROR IS * 60620000 * DETECTED RETURN IS TO THE HIGHEST LEVEL CALLING ROUTINE. * 60690000 * 60760000 * 60830000 * 60900000 * UPON ENTRY -- REGISTER 0 CONTAINS A MESSAGE CODE 60970000 * REGISTER 1 CONTAINS A POINTER TO QUALIFYING 61040000 * INFORMATION (IF IT EXISTS) 61110000 * 61180000 * 61250000 ENTRY IEWERROR 61320000 * 61390000 *********************************************************************** 61460000 IEWERROR SAVE (14,12),,* SAVE CALLERS REGISTERS 61530000 USING IEWERROR,R15 IDENTIFY ENTRY POINT BASE 61600000 L R12,AUTOCALL LOAD CSECT BASE 61670000 DROP R15 DROP ENTRY POINT BASE 61740000 USING IEWACALL,R12 AND IDENTIFY CSECT BASE 61810000 SPACE 61880000 L R13,8(R13) GET NEXT SAVE AREA POINTER 61950000 SPACE 62020000 LR R2,R0 MOVE ERROR CODE 62090000 LA R3,1 SET BIT 62160000 SLL R3,0(R2) SHIFT BY ERROR CODE 62230000 O R3,CMBITMAP INSERT INTO BITMAP 62300000 ST R3,CMBITMAP AND STORE BITMAP BACK 62370000 * 62440000 AR R2,R2 FORM INDEX 62510000 AR R2,R2 FROM ERROR CODE 62580000 * 62650000 TM CMPRMFLG,CQTERM WAS TERM OPTION PASSED 62660000 BNO RRCHKPRT NO. CHECK SYSPRINT 62670000 L R8,CMTRMREC YES. GET PTR TO TERM BUFFER 62680000 LA R9,TRMRECSZ-MSGPLEN MAXIMUM LENGTH OF IDENTIFYING INFO 62690000 BAL R14,RRSETUP MOVE MESSAGE IN 62700000 L R15,TRMRTN AND PRINT IT 62710000 BALR R14,R15 62720000 RRCHKPRT TM CMSTATUS,CQPRTOPN IS THE SYSPRINT DATA SET OPEN 62730000 BZ RRERCODE NO - DON'T SET UP MESSAGE 62790000 * 62860000 LH R6,CMWTBFCT IS THERE ANYTHING 62930000 LTR R6,R6 IN THE PRINT BUFFER 63000000 BZ RRMESSG NO - DON'T PURGE 63070000 * 63140000 L R15,PRTRTN YES - GO PURGE 63210000 BALR R14,R15 CURRENT PRINT BUFFER 63280000 * 63350000 RRMESSG L R8,CMPUTREC GET POINTER TO PRINT BUFFER 63420000 LH R9,CMWLRECL GET LENGTH OF PRINT BUFFER 63430000 LA R3,MSGPLEN GET LENGTH OF PREFIX 63440000 SR R9,R3 GET LENGTH OF QUALIFYING INFO 63450000 BAL R14,RRSETUP MOVE MESSAGE IN 63460000 B RRPRNT AND GO PRINT IT 63470000 * 63480000 * SET UP MESSAGE IN BUFFER POINTED TO BY R8 63490000 * R9 CONTAINS MAXIMUM LENGTH OF QUALIFYING INFO 63500000 USING MSGDSECT,R8 63510000 RRSETUP EQU * 63520000 * 63560000 L R7,ERTABLE(R2) GET POINTER TO MESSAGE NUMBER 63630000 MVC MSGPREFX(4),RRPREFX MOVE PREFIX TO PRINT BUFFER 63700000 MVC MSGNUMBR(3),0(R7) AND MOVE IN MESSAGE NUMBER 63770000 * 63840000 SR R6,R6 GET QUALIFYING 63910000 SLDL R6,8 DATA LENGTH 63980000 LTR R6,R6 IS THERE ANY 64050000 BZ RRSETRTN NO. RETURN 64120000 * 64190000 CR R6,R9 WILL IT OVERFLOW BUFFER 64200000 BNH RRMOV NO. OKAY 64210000 LR R6,R9 YES. TRUNCATE IT 64220000 RRMOV EQU * 64230000 BCTR R6,0 DECREMENT LENGTH FOR EXECUTE 64260000 EX R6,RRXTRAMV AND MOVE INFO INTO PRINT BUFFER 64330000 RRSETRTN BR R14 RETURN 64360000 * 64400000 RRPRNT L R15,PRTRTN AND PRINT 64470000 BALR R14,R15 THE ERROR MESSAGE 64540000 * 64610000 RRERCODE L R7,ERTABLE(R2) RELOAD POINTER TO MESSAGE NUMBER 64680000 IC R15,2(R7) PICK UP LOW ORDER CHARACTER 64750000 LA R6,7 GET SEVERITY CODE 64756000 NR R15,R6 64762000 LA R6,1 64768000 TM CMPRMFLG,CQLET IS 'LET' SPECIFIED 64774000 BZ RRTSTCOD NO 64780000 SR R15,R6 YES. REDUCE CONDITION CODE BY 1 64786000 RRTSTCOD CR R15,R6 IS IT ONE OR LESS 64792000 BNH RRTRYH YES. OKAY 64798000 OI CMFLAG4,CQNOEX SET 'NO EXECUTION' FLAG 64804000 RRTRYH IC R15,2(R7) RELOAD CODE 64810000 LA R6,4 AND OFF ALL 64820000 NR R15,R6 BUT SEVERITY 4 64890000 RRABORT L R13,4(R13) IF MESSAGE NOT SEVERITY 4 -- RETURN 64960000 BZ RRRETURN 65030000 SPACE 65100000 * A SEVERITY 4 ERROR HAS BEEN DETECTED ---- EXECUTION IS NO LONGER 65170000 * POSSIBLE. THE FOLLOWING CODE WILL PROCEED BACK THROUGH THE SAVE 65240000 * AREA CHAIN TO THE HIGHEST LEVEL ROUTINE SO THAT DATA-SETS CAN BE 65310000 * CLOSED AND MAIN STORAGE FREED. 65380000 * 65450000 * 65520000 OI CMSTATUS,CQABORT SET ABORT BIT FOR CONTROL 65590000 TM CMSTATUS,CQRETURN RETURN REQUESTED-SEVERITY 4 65660000 BO RRRETURN 65730000 C R13,CMFSTSAV DOES R13 POINT TO FIRST SAVE AREA 65800000 BNE RRABORT NO - GO TRY NEXT 65870000 * 65940000 RRRETURN RETURN (14,12),T 66010000 * 66080000 * 66150000 RRXTRAMV MVC MSGTEXT(0),0(R1) EXECUTED MOVE TEXT INTO MESSAGE 66220000 EJECT 66290000 *********************************************************************** 66360000 * * 66430000 * ERROR BIT-MAP PROCESSOR --- DIAGNOSTIC MESSAGE DICTIONARY PRINT * 66500000 * * 66570000 * THE BIT MAP IS CHECKED FOR ALL ZERO (NO ERRORS) * 66640000 * IF IT IS ALL ZERO--IT SETS THE CONDITION CODE AND RETURNS * 66710000 * * 66780000 * MESSAGES TO BE PRINTED ARE SELECTED VIA INDEX INTO THE * 66850000 * MESSAGE TABLE USING THE POSITION OF THE BIT SET IN THE BIT * 66920000 * MAP AS THE INDEX VALUE. * 66990000 * * 67060000 * PRINTS MESSAGES ON SYSPRINT AND/OR SYSTERM. * 67100000 * IF NEITHER ARE WANTED, THE MESSAGES ARE * 67140000 * NOT PRINTED BUT THE BIT MAP IS STILL SCANNED FOR THE * 67200000 * HIGHEST SEVERITY CODE. * 67270000 * * 67340000 * BEFORE RETURNING THE SEVERITY CODE IS CHANGED TO THE CONDITION * 67410000 * CODE AND SET IN REGISTER 15. * 67480000 * * 67550000 *********************************************************************** 67620000 SPACE 3 67690000 IEWBTMAP SAVE (14,12),,* 67760000 ENTRY IEWBTMAP 67830000 USING IEWBTMAP,R15 67900000 L R12,AUTOCALL 67970000 DROP R15 68040000 USING IEWACALL,R12 68110000 SPACE 68180000 L R13,8(R13) 68250000 SPACE 68320000 SPACE 68390000 L R3,CMBITMAP LOAD BIT-MAP 68460000 SR R0,R0 INITIALIZE SEVERITY CODE 68530000 LTR R3,R3 IS IT ALL ZERO 68600000 BZ BMRETURN YES - RETURN 68670000 SPACE 68740000 MVI CMPRTCTL,CTSPACE3 SET UP CARRIAGE CONTROL 68810000 SR R2,R2 SET INDEX TO ZERO 68880000 LA R5,127 SET MASK 68950000 BMCHKBIT LA R4,1 CHECK IF LOW ORDER 69020000 NR R4,R3 BIT IS SET IN BIT-MAP 69090000 BZ BMNXTCHK NO - DON'T PRINT THIS MESSAGE 69160000 L R6,ERTABLE(R2) GET PTR TO ERROR TABLE 69230000 IC R0,2(R6) SAVE SEVERITY CODE 69300000 TM CMPRMFLG,CQTERM WAS TERM OPTION PASSED 69310000 BZ BMCHKPRT NO. CHECK SYSPRINT 69320000 L R8,CMTRMREC YES. GET POINTER TO TERM BUFFER 69330000 BAL R14,BMSETUP MOVE MESSAGE IN 69340000 L R15,TRMRTN AND 69350000 BALR R14,R15 PRINT IT 69360000 BMCHKPRT TM CMSTATUS,CQPRTOPN PRINT OPEN 69370000 BZ BMNXTCHK NO-SKIP BIT MAP 69440000 L R8,CMPUTREC YES - GET POINTER TO PRINT BUF 69510000 L R6,ERTABLE(R2) GET PTR TO ERROR TABLE 69515000 BAL R14,BMSETUP MOVE MESSAGE IN 69520000 B BMPRNT AND PRINT IT 69530000 BMSETUP EQU * 69540000 MVC 1(4,R8),RRPREFX MOVE 'IEW1' TO PRINT BUFFER 69580000 MVC 5(3,R8),0(R6) MOVE IN MESSAGE NUMBER 69650000 SR R7,R7 69720000 LA R8,12(R8) UPDATE PRINT BUFFER POINTER 69790000 SPACE 69860000 BMMESSG LA R6,4(R6) JUMP TO NEXT LENGTH-ADCON PAIR 69930000 L R9,0(R6) LOAD THE ADCON TO PHRASE 70000000 IC R7,0(R6) LOAD THE LENGTH OF THE PHRASE 70070000 NR R7,R5 KNOCK OFF INDICATOR BIT 70140000 EX R7,MVPHRASE AND MOVE THE PHRASE TO PRNT BUF 70210000 LTR R9,R9 WAS THAT THE LAST PHRASE IN MESSAGE 70280000 LA R8,1(R7,R8) UPDATE THE PRINT BUFFER POINTER 70350000 BC 11,BMMESSG N/ - GO MOVE NEXT PHRASE 70420000 BR R14 RETURN 70440000 BMPRNT EQU * 70460000 SPACE 70490000 L R15,PRTRTN YES - GET ADDRESS OF PRINT RTN 70560000 BALR R14,R15 AND GO PRINT THE MESSAGE 70630000 SPACE 2 70700000 BMNXTCHK SRA R3,1 SHIFT BIT-MAP RIGHT 70770000 LA R2,4(R2) UPDATE INDEX INTO ERROR TABLE 70840000 BNZ BMCHKBIT AND GO CHECK THIS BIT (IF ANY) 70910000 SPACE 3 70980000 BMRETURN L R13,4(R13) ALL DONE - PICK UP PREVIOUS SAVE 71050000 LA R15,7 PUT SEVERITY CODE INTO 71120000 NR R15,R0 REGISTER 15 AND 71190000 SLL R15,2 CHANGE TO CONDITION C 71260000 BZ BMRET RETURN IF CONDITION CODE ZERO 71330000 LA R14,8 SEVERITY 2 CONSTANT A56493 71380021 CR R15,R14 CK FOR ERROR GT SEV 2 A56493 71390021 BH BMRET YES GT SEV 2 A56493 71392021 TM CMPRMFLG,CQLET LET SPECIFIED 71400000 BZ BMRET NO-RETURN 71470000 LA R10,4 SUBTRACT FOUR FROM 71540000 SR R15,R10 CONDITION CODE 71610000 BMRET RETURN (14,12),T,RC=(15) RETURN 71680000 SPACE 71750000 MVPHRASE MVC 0(0,R8),0(R9) EXECUTED MOVE PHRASE TO PRINT BUFFER 71820000 EJECT 71890000 ERTABLE DS 0F 71960000 DC AL1(8) 72030000 DC AL3(MSRELO1) 72100000 DC AL1(0) 72170000 DC AL3(MSENTR1) 72240000 DC AL1(80) 72310000 DC AL3(MSINPT8) 72380000 SPACE 72450000 DC AL1(0) 72520000 DC AL3(MSINPT10) 72590000 DC AL1(0) 72660000 DC AL3(MSINPT2) 72730000 DC AL1(8) 72800000 DC AL3(MSRELO2) 72870000 DC AL1(8) 72940000 DC AL3(MSINPT4) 73010000 DC AL1(0) 73080000 DC AL3(MSINPT5) 73150000 DC AL1(0) 73220000 DC AL3(MSINPT7) 73290000 DC AL1(80) 73360000 DC AL3(MSINPT9) 73430000 DC AL1(8) 73500000 DC AL3(MSINPT1) 73570000 SPACE 73640000 DC AL1(0) 73710000 DC AL3(MSINPT3) 73780000 DC AL1(8) 73850000 DC AL3(MSENTR2) 73920000 DC AL1(0) 73990000 DC AL3(MSIOUT4) 74060000 DC AL1(0) 74130000 DC AL3(MSINPT6) 74200000 SPACE 74270000 DC AL1(8) 74340000 DC AL3(MSIOUT3) 74410000 DC AL1(8) 74480000 DC AL3(MSIOUT1) 74550000 DC AL1(67) 74620000 DC AL3(MSIOUT2) 74690000 DC AL1(0) 74760000 DC AL3(MSSIZE2) 74830000 DC AL1(0) 74900000 DC AL3(MSSIZE3) 74970000 DC AL1(8) 74980000 DC AL3(MSIDEN1) 74990000 DC AL1(8) 75000000 DC AL3(MSIDEN2) 75010000 DC AL1(8) M5453 75020021 DC AL3(MSINPT11) M5453 75030021 SPACE 75040000 PHRASE1 DC C'WARNING - ' 75110000 PLNGTH1 EQU *-PHRASE1 75180000 SPACE 75250000 PHRASE2 DC C'ERROR - ' 75320000 PLNGTH2 EQU *-PHRASE2 75390000 SPACE 75460000 PHRASE3 DC C'UNRESOLVED EXTERNAL REFERENCE' 75530000 PLNGTH3 EQU *-PHRASE3 75600000 SPACE 75670000 PHRASE4 DC C' (NOCALL SPECIFIED)' M5454 75740021 PLNGTH4 EQU *-PHRASE4 75810000 SPACE 75880000 PHRASE5 DC C'NO ' 75950000 PLNGTH5 EQU *-PHRASE5 76020000 SPACE 76090000 PHRASE6 DC C'ENTRY POINT ' 76160000 PLNGTH6 EQU *-PHRASE6 76230000 SPACE 76300000 PHRASE7 DC C'RECEIVED' 76370000 PLNGTH7 EQU *-PHRASE7 76440000 SPACE 76510000 PHRASE8 DC C'INVALID' 76580000 PLNGTH8 EQU *-PHRASE8 76650000 SPACE 76720000 PHRASE9 DC C' NOT AN OBJECT RECORD' 76790000 PLNGTH9 EQU *-PHRASE9 76860000 SPACE 76930000 PHRASE10 DC C' SPECIFIED' 77000000 PLNGTH10 EQU *-PHRASE10 77070000 SPACE 77140000 PHRASE11 DC C'UNACCEPTABLE ' 77210000 PLNGTH11 EQU *-PHRASE11 77280000 SPACE 77350000 PHRASE12 DC C'RECORD FORMAT' 77420000 PLNGTH12 EQU *-PHRASE12 77490000 SPACE 77560000 PHRASE13 DC C'NO TEXT ' 77630000 PLNGTH13 EQU *-PHRASE13 77700000 SPACE 77770000 PHRASE14 DC C' RECORD FROM ' 77840000 PLNGTH14 EQU *-PHRASE14 77910000 SPACE 77980000 PHRASE15 DC C'OBJECT MODULE' 78050000 PLNGTH15 EQU *-PHRASE15 78120000 SPACE 78190000 PHRASE16 DC C'LOAD MODULE' 78260000 PLNGTH16 EQU *-PHRASE16 78330000 SPACE 78400000 SPACE 78470000 PHRASE18 DC C'CARD ' 78540000 PLNGTH18 EQU *-PHRASE18 78610000 SPACE 78680000 PHRASE19 DC C' LENGTH' 78750000 PLNGTH19 EQU *-PHRASE19 78820000 SPACE 78890000 PHRASE20 DC C'DOUBLY DEFINED ESD' 78960000 PLNGTH20 EQU *-PHRASE20 79030000 SPACE 79100000 PHRASE21 DC C' 2 BYTE ADCON' 79170000 PLNGTH21 EQU *-PHRASE21 79240000 SPACE 79310000 PHRASE22 DC C' ID ' 79380000 PLNGTH22 EQU *-PHRASE22 79450000 SPACE 79520000 PHRASE23 DC C'BLKSIZE IS ' 79590000 PLNGTH23 EQU *-PHRASE23 79660000 SPACE 79730000 PHRASE24 DC C' (VARIABLE ON INPUT)' 79800000 PLNGTH24 EQU *-PHRASE24 79870000 SPACE 79940000 PHRASE25 DC C' BUT NOT MATCHED' 80010000 PLNGTH25 EQU *-PHRASE25 80080000 SPACE 80150000 PHRASE26 DC C'I/O ERROR WHILE SEARCHING LIBRARY DIRECTORY' 80220000 PLNGTH26 EQU *-PHRASE26 80290000 SPACE 80360000 PHRASE27 DC C'DDNAME ' 80430000 PLNGTH27 EQU *-PHRASE27 80500000 SPACE 80570000 PHRASE28 DC C'CANNOT BE OPENED' 80640000 PLNGTH28 EQU *-PHRASE28 80710000 SPACE 80780000 PHRASE29 DC C'HAD SYNCHRONOUS ERROR' 80850000 PLNGTH29 EQU *-PHRASE29 80920000 SPACE 80990000 SPACE 81060000 PHRASE31 DC C'AVAILABLE STORAGE EXCEEDED' 81130000 PLNGTH31 EQU *-PHRASE31 81200000 SPACE 81270000 PHRASE32 DC C' TOO LARGE' 81340000 PLNGTH32 EQU *-PHRASE32 81410000 SPACE 81480000 PHRASE33 DC C'TOO MANY EXTERNAL NAMES IN INPUT MODULE' 81550000 PLNGTH33 EQU *-PHRASE33 81620000 SPACE 2 81690000 PHRASE34 DC C'END ' 81760000 PLNGTH34 EQU *-PHRASE34 81830000 PHRASE35 DC C'IDENTIFICATION FAILED' 81840000 PLNGTH35 EQU *-PHRASE35 81850000 PHRASE36 DC C' - DUPLICATE PROGRAM NAME FOUND' 81860000 PLNGTH36 EQU *-PHRASE36 81870000 PHRASE37 DC C'COMMON EXCEEDS SIZE OF CSECT WITH SAME NAME' M5453 81880021 PLNGTH37 EQU *-PHRASE37 M5453 81890021 DS 0F 81900000 MSRELO1 DC C'001 ' 81970000 DC AL1(PLNGTH1-1),AL3(PHRASE1) 82040000 DC AL1(PLNGTH3-1),AL3(PHRASE3) 82110000 DC AL1(128+PLNGTH4-1),AL3(PHRASE4) 82180000 SPACE 82250000 MSRELO2 DC C'012 ' 82320000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 82390000 DC AL1(128+PLNGTH3-1),AL3(PHRASE3) 82460000 SPACE 82530000 MSIOUT1 DC C'024 ' 82600000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 82670000 DC AL1(PLNGTH27-1),AL3(PHRASE27) 82740000 DC AL1(128+PLNGTH28-1),AL3(PHRASE28) 82810000 SPACE 82880000 MSIOUT2 DC C'034 ' 82950000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 83020000 DC AL1(PLNGTH27-1),AL3(PHRASE27) 83090000 DC AL1(128+PLNGTH29-1),AL3(PHRASE29) 83160000 SPACE 83230000 MSIOUT3 DC C'044 ' 83300000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 83370000 DC AL1(PLNGTH11-1),AL3(PHRASE11) 83440000 DC AL1(PLNGTH12-1),AL3(PHRASE12) 83510000 DC AL1(128+PLNGTH24-1),AL3(PHRASE24) 83580000 SPACE 83650000 MSIOUT4 DC C'053 ' 83720000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 83790000 DC AL1(128+PLNGTH26-1),AL3(PHRASE26) 83860000 SPACE 83930000 SPACE 84000000 MSINPT1 DC C'072 ' 84070000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 84140000 DC AL1(PLNGTH23-1),AL3(PHRASE23) 84210000 DC AL1(128+PLNGTH8-1),AL3(PHRASE8) 84280000 SPACE 84350000 MSINPT2 DC C'082 ' 84420000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 84490000 DC AL1(PLNGTH8-1),AL3(PHRASE8) 84560000 DC AL1(PLNGTH19-1),AL3(PHRASE19) 84630000 DC AL1(128+PLNGTH10-1),AL3(PHRASE10) 84700000 SPACE 84770000 MSINPT3 DC C'093 ' 84840000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 84910000 DC AL1(PLNGTH13-1),AL3(PHRASE13) 84980000 DC AL1(128+PLNGTH7-1),AL3(PHRASE7) 85050000 SPACE 85120000 MSINPT4 DC C'102 ' 85190000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 85260000 DC AL1(128+PLNGTH20-1),AL3(PHRASE20) 85330000 SPACE 85400000 MSINPT5 DC C'112 ' 85470000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 85540000 DC AL1(PLNGTH8-1),AL3(PHRASE8) 85610000 DC AL1(128+PLNGTH21-1),AL3(PHRASE21) 85680000 SPACE 85750000 MSINPT6 DC C'123 ' 85820000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 85890000 DC AL1(PLNGTH8-1),AL3(PHRASE8) 85960000 DC AL1(PLNGTH14-1),AL3(PHRASE14) 86030000 DC AL1(128+PLNGTH16-1),AL3(PHRASE16) 86100000 SPACE 86170000 MSINPT7 DC C'132 ' 86240000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 86310000 DC AL1(PLNGTH8-1),AL3(PHRASE8) 86380000 DC AL1(PLNGTH22-1),AL3(PHRASE22) 86450000 DC AL1(128+PLNGTH7-1),AL3(PHRASE7) 86520000 SPACE 86590000 MSINPT8 DC C'141 ' 86660000 DC AL1(PLNGTH1-1),AL3(PHRASE1) 86730000 DC AL1(PLNGTH18-1),AL3(PHRASE18) 86800000 DC AL1(PLNGTH7-1),AL3(PHRASE7) 86870000 DC AL1(128+PLNGTH9-1),AL3(PHRASE9) 86940000 SPACE 87010000 MSINPT9 DC C'152 ' 87080000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 87150000 DC AL1(PLNGTH8-1),AL3(PHRASE8) 87220000 DC AL1(PLNGTH14-1),AL3(PHRASE14) 87290000 DC AL1(128+PLNGTH15-1),AL3(PHRASE15) 87360000 SPACE 87430000 MSINPT10 DC C'182 ' 87500000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 87570000 DC AL1(PLNGTH5-1),AL3(PHRASE5) 87640000 DC AL1(PLNGTH34-1),AL3(PHRASE34) 87710000 DC AL1(PLNGTH18-1),AL3(PHRASE18) 87780000 DC AL1(128+PLNGTH7-1),AL3(PHRASE7) 87850000 MSINPT11 DC C'232 ' M5453 87900021 DC AL1(PLNGTH2-1),AL3(PHRASE2) M5453 87910021 DC AL1(128+PLNGTH37-1),AL3(PHRASE37) M5453 87912021 MSENTR1 DC C'161 ' 87920000 DC AL1(PLNGTH1-1),AL3(PHRASE1) 87990000 DC AL1(PLNGTH5-1),AL3(PHRASE5) 88060000 DC AL1(PLNGTH6-1),AL3(PHRASE6) 88130000 DC AL1(128+PLNGTH7-1),AL3(PHRASE7) 88200000 SPACE 88270000 MSENTR2 DC C'173 ' 88340000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 88410000 DC AL1(PLNGTH6-1),AL3(PHRASE6) 88480000 DC AL1(PLNGTH7-1),AL3(PHRASE7) 88550000 DC AL1(128+PLNGTH25-1),AL3(PHRASE25) 88620000 SPACE 88690000 MSSIZE2 DC C'194 ' 88760000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 88830000 DC AL1(128+PLNGTH31-1),AL3(PHRASE31) 88900000 SPACE 88970000 MSSIZE3 DC C'204 ' 89040000 DC AL1(PLNGTH2-1),AL3(PHRASE2) 89110000 DC AL1(128+PLNGTH33-1),AL3(PHRASE33) 89140000 MSIDEN1 DC C'214 ' 89170000 DC AL1(PLNGTH35-1),AL3(PHRASE35) 89200000 DC AL1(128+PLNGTH36-1),AL3(PHRASE36) 89230000 MSIDEN2 DC C'224 ' 89260000 DC AL1(128+PLNGTH35-1),AL3(PHRASE35) 89290000 RRPREFX DC C'IEW1' 89320000 AUTOCALL DC A(IEWACALL) 89390000 LOADRTN DC A(IEWLODE) LOAD MODULE PROCESSOR 89460000 RLDRTN DC V(IEWLRLD) RLD PROCESSOR 89530000 READRTN DC V(IEWLREAD) READ ROUTINE 89600000 CESDRTN DC V(IEWLESD) ESD AND CESD PROCESSOR 89670000 LOGRTN DC A(IEWERROR) ERROR LOG ROUTINE 89740000 EOMRTN DC V(IEWLEND) END CARD AND END OF MODULE 89810000 * PROCESSOR 89880000 RENUMID DC V(TRANSID) RENUMBER TBL-ID ROUTINE 89950000 MAPRTN DC V(IEWLMAP) MAP PROCESSOR 90020000 OPNSYSLI DC V(IEWOPNLB) OPEN SYSLIB ROUTINE 90090000 PRTRTN DC V(IEWLPRNT) PRINT ROUTINE 90160000 TRMRTN DC V(IEWTERM) SYSTERM OUTPUT ROUTINE 90190000 RLDRES DC V(IEWLERTN) RLD RESOLUTION ROUTINE 90230000 PRIMRTN DC V(IEWPRIME) BUFFER PRIME ROUTINE 90300000 RELORTN DC V(IEWLRELO) OBJECT MODULE PROCESSOR 90370000 CNVTRTN DC V(IEWLCNVT) CONVERT TO HEX ROUTINE 90440000 COUNTAND DC X'0000FFFF' CONSTANT FOR AND INST 90510000 MSG2 DC C'TOTAL LENGTH' 90580000 MSG2LNG EQU *-MSG2 90650000 MSG3 DC C'ENTRY ADDRESS' 90720000 MSG3LNG EQU *-MSG3 90790000 MAINTDS DS 37F 90860000 EJECT 90930000 * MESSAGE LINE FORMAT DSECT 91000000 SPACE 2 91070000 MSGDSECT DSECT 91140000 DC C' ' 91210000 MSGPREFX DC C'IEW0' MESSAGE PREFIX 91280000 MSGNUMBR DS CL3 MESSAGE NUMBER (AND SEVERITY) 91350000 DC C' ' 91420000 MSGTEXT DS C QUALIFYING INFORMATION 91490000 MSGPLEN EQU MSGTEXT-MSGDSECT LENGTH OF PREFIX,ETC 91520000 CVTSECT DSECT 91560000 CVT 91630000 IEWLDCOM 91700000 DCNTRLB DSECT 91770000 DTYPE DS CL1 TYPE IDENTIFICATION 91840000 DS CL3 91910000 DESID DS CL2 ESDID OF FIRST ESD ITEM 91980000 DCOUNT DS CL2 BYTES OF ESD DATA 92050000 DESDDATA EQU * START OF ESD DATA 92120000 ORG DESID 92190000 DCNTIDLN DS CL2 BYTES OF ID/LENGTH LIST 92260000 DS CL2 92330000 DCCW EQU * CHANNEL COMMAND WORD 92400000 DADDR DS CL4 DATA ADDRESS 92470000 DCCOUNT DS CL4 BYTES OF TXT DATA 92540000 DID DS CL2 CESD ENTRY NUMBER 92610000 DLENGTH DS CL2 LENGTH OF TEXT RECORD 92680000 ORG DCOUNT 92750000 DRLDCNT DS CL2 BYTES OF RLD INFORMATION 92820000 DS CL8 92890000 DRLDDATA EQU * START OF RLD DATA 92960000 CDENTRY DSECT 93030000 CDCHAIN DS 4C CHAIN ADDR-NEXT ENTRY 93100000 CDROLL DS 1C COUNT OF ROLL OUTS 93170000 CDRPB DS 3C ADDRESS OF PRB 93240000 CDNAME DS 8C NAME 93310000 CDENTPT DS 4C RELOCATED ENTRY POINT 93380000 END 93450000 ./ ADD SSI=00011363,NAME=IEWLDREL,SOURCE=0 REL TITLE 'IEWLRELO--OBJECT MODULE PROCESSING AND RELOCATION' 00060000 *STATUS - CHANGE LEVEL 20 * 00090000 * INCREMENTAL 288 - W-CON ADDED INC288 00130000 * APAR FIX 27445 - ZERO/LENGTH CSECTS OKAY 00140000 * APAR 30142 DUPLICATE CSECTS $256300-256400,257200 00142021 * $257400-258000 00144021 * APAR 30162 BAD IEW1182 MSG $119100,131200 00146021 * APAR 62460 $247200,$248400-248992 00148021 * TSO CHANGES FOR IDENTIFY AND INCORE DATA SET * 00150000 * APAR 70542 LRS INCORRECTLY RESOLVED $239400,334800,355800, 00160021 * $760200,817300 00170021 *FUNCTION/OPERATION: * 00180000 * 1)IEWLRELO-DETERMINES RECORD TYPE,THEN PASSES CONTROL TO THE * 00240000 * APPROPRIATE ROUTINE FOR RECORD PROCESSING * 00300000 * 2)IEWLESD-PROCESSES ESD RECORDS,BUILDS AND MAINTAINS CESD * 00360000 * 3)IEWLTXT-PROCESSES TXT RECORDS * 00420000 * 4)IEWLRLD-PROCESSES RLD RECORDS,BUILDS AND MAINTAINS RLD * 00480000 * TABLE * 00540000 * 5)IEWLEND-PROCESSES END RECORDS,DEFINES ENTRY POINT,UPDATES * 00600000 * THE TEXT LOCATION POINTER, CLEARS THE TRANSLATION * 00660000 * TABLE * 00720000 * 6)ALLOCATE-ALLOCATES STORAGE FOR THE CESD,RLD TABLE AND * 00780000 * TRANSLATION TABLE * 00840000 * 7)TRANSID-TRANSLATES ESDID TO TRANSLATION TABLE ENTRY ADDRESS* 00900000 * 8)IEWLERTN-RELOCATES RLDS * 00960000 * 9)IEWLMAP-CREATES MAP PRINTOUT * 01020000 * 10)IEWLCNVT-CONVERTS BINARY QUANTITIES TO PRINT CHARACTERS * 01080000 * 11)IEWLMOD - PROCESSES MOD RECORDS * 01110000 *ENTRY POINTS: * 01140000 * 1)IEWLRELO-FOR OBJECT MODULE PROCESSING * 01200000 * 2)IEWLESD-FOR ESD PROCESSING * 01260000 * 3)IEWLRLD-FOR RLD PROCESSING * 01320000 * 4)IEWLEND-FOR END OF MODULE PROCESSING * 01380000 * 5)TRANSID-FOR ESDID-TRANSLATION TABLE ADDRESS CONVERSION * 01440000 * 6)IEWLERTN-FOR RELOCATION OF RLDS ON CHAIN * 01500000 * 7)IEWLCNVT-FOR CONVERSION TO PRINT CHARACTERS * 01560000 * 8)IEWLMAP-FOR MAKING MAP ENTRIES * 01620000 *INPUT: ALL ROUTINES EXPECT: * 01680000 * #13-ADDR OF SAVE AREA * 01740000 * #14-RETURN ADDRESS * 01800000 * #11-ADDR.OF COMMUNICATIONS AREA * 01860000 * IN ADDITION: * 01920000 * IEWLESD EXPECTS: * 01980000 * #5-ID OF FIRST ESD ITEM * 02040000 * #7-LENGTH OF ESD INFORMATION * 02100000 * #8-ADDRESS OF ESD INFORMATION * 02160000 * IEWLRLD EXPECTS: * 02220000 * #7-LENGTH OF RLD INFORMATION * 02280000 * #8-ADDRESS OF RLD INFORMATION * 02340000 * TRANSID EXPECTS: * 02400000 * #5-ID TO BE TRANSLATED * 02460000 * IEWLERTN EXECTS: * 02520000 * #1-STARTING ADDRESS OF RLD CHAIN * 02580000 * #9-ADDRESS OF CESD ENTRY TO BE USED FOR RELOCATION * 02640000 * IEWLCNVT EXPECTS: * 02700000 * #1-QUANTITY TO BE CONVERTED * 02760000 * IEWLMAP EXPECTS: * 02820000 * #9-ADDRESS OF CESD ENTRY TO BE MAPPED * 02880000 * IEWLMOD EXPECTS - 02890000 * #7=LENGTH OF MOD INFO * 02900000 * #8=ADDRESS OF MOD INFO * 02910000 *OUTPUT: IEWLCNVT:CMXDBLWD CONTAINS CONVERTED VALUE * 02940000 * TRANSID:#1-CONTAINS TRANSLATION TABLE ENTRY ADDRESS * 03000000 *EXTERNAL ROUTINES: * 03060000 * IEWLREAD-READ AND DEBLOCK OBJECT RECORDS * 03120000 * IEWLPRNT-PRINT MAP * 03180000 * IEWERROR-LOG ERRORS * 03240000 *EXITS-NORMAL:TO CALLER * 03300000 * -ERROR:TO IEWERROR LA 0,ERRCODE * 03360000 * L 15,=V(IEWERROR) * 03420000 * BALR 14,15 * 03480000 * * 03540000 *TABLES/WORKAREAS: REFER TO LOADER PLM FOR DETAILED DESCRIPTION * 03600000 * 1)CESD * 03660000 * 2)RLD TABLE * 03720000 * 3)TRANSLATION TABLE * 03780000 * 4)COMMUNICATIONS AREA(IEWLOCOM) * 03840000 *ATTRIBUTES: READ ONLY,REUSABLE,REENTRANT * 03900000 *NOTES: NONE * 03960000 *********************************************************************** 04020000 EJECT 04080000 IEWLRELO CSECT 04140000 *A073800 A39336 04160021 *C244900-245000 A39336 04180021 *A750000,760800 A46172 04190021 *A621500-621520,D837600-846300,A867700-868706,D868200,A868733 A47048 04192021 * SA49491 04194000 * SA56381 04196021 * SA59776 04198021 * M5453 04198421 * M5478 04198821 * * 04200000 * REGISTER ASSIGNMENTS * 04260000 * * 04320000 BRANCH EQU 15 BRANCH REGISTER 04380000 RETURN EQU 14 LINK REGISTER 04440000 SAVEREG EQU 13 SAVE AREA POINTER 04500000 BASE EQU 12 BASE REGISTER 04560000 CMPTR EQU 11 POINTER TO COMMUNICATIONS AREA 04620000 BASE2 EQU 10 SECOND BASE REG SA49491 04680000 CESD EQU 9 CESD ENTRY ADDR 04740000 PTR EQU 8 USED FOR POINTER VALUE 04800000 * -POINTER WITHIN INPUT BUF. 04860000 * -POINTER WITHIN OUTPUT BUF. 04920000 LNG EQU 7 LENGTH OF INFORMATION 04980000 ADR EQU 6 ADDR FROM OBJECT RECORD 05040000 ID EQU 5 ID 05100000 WORKC EQU 4 WORK REG.-EVEN FOR DEV 05160000 WORKA EQU 3 WORK REG.-ODD FOR BXLE 05220000 WORKB EQU 2 WORK REG. 05280000 PARM EQU 1 PARAMETER REGISTER 05340000 ZERO EQU 0 05400000 * * 05460000 * MAP FORMAT DISPLACEMENTS * 05520000 PREFIXNM EQU 2 05580000 NAME EQU 3 05640000 TYPE EQU 14 05700000 ADDR EQU 17 05760000 SUFFIXNM EQU 11 05820000 ENTRYSZ EQU 24 05880000 * * 05940000 * CESD DISPLACEMENTS * 06000000 * * 06060000 CNAME EQU 4 06120000 CTYPE EQU 12 06180000 CADR EQU 12 06240000 CREL EQU 16 06300000 CLNG EQU 16 06360000 * * 06420000 * CESD INDICATORS * 06480000 * * 06540000 SD EQU X'00' SECTION DEFINITION 06600000 LD EQU X'01' LABEL DEFINITION 06660000 ER EQU X'02' EXTERNAL REFERENCE 06720000 LR EQU X'03' LABEL REFERENCE 06780000 PC EQU X'04' PRIVATE CODE 06840000 CM EQU X'05' COMMON 06900000 PR EQU X'06' PSEUDO REGISTER 06960000 NULL EQU X'07' NULL ENTRY 07020000 DELETE EQU X'80' DELETE INDICATOR 07080000 NOLEN EQU X'20' ZERO LENGTH 27445 07110000 DELINK EQU X'80' RLD'S FOR ENTRY NEED DELINKING 07140000 LDCHAIN EQU X'40' ON LD CHAIN,ALREADY PROCESSED 07200000 * THIS RECORD 07260000 WX EQU X'0A' W-CON - EXTERNAL FORMAT INC288 07270000 WEAKCALL EQU X'40' W-CON - INTERNAL FORMAT INC288 07280000 NEVERCAL EQU X'08' 'ER' NEVER CALL 07320000 BLANK EQU C' ' 07380000 ERWEAK EQU X'42' FOR ER AND WEAKCALL BIT CHECK A39336 07410021 ******** ******** 07440000 * TRANSLATION TABLE INDICATORS * 07500000 ******** ******** 07560000 ERMATCH EQU X'80' ABSOLUTE RELOCATION INDIC. 07620000 * * 07680000 * ESD DISPLACEMENTS * 07740000 * * 07800000 ENAME EQU 0 07860000 ETYPE EQU 8 07920000 EADR EQU 8 07980000 ELNG EQU 12 08040000 ESUBTYP EQU 13 SUBTYPE FIELD 08100000 EID EQU 14 08160000 ESDADDR EQU 12 08220000 ESEGNO EQU 12 SEGMENT NUMBER 08280000 * * 08340000 * RLD FLAGS * 08400000 * * 08460000 CONT EQU X'01' 08520000 VCON EQU X'10' CHECK FOR ABSOLUTE RELOCATION 08580000 PRRLD EQU X'20' PSEUDO REGISTER RLD INDICATOR 08640000 ACCUMPR EQU X'30' ACCUMULATIVE PSEUDO REGISTER 08700000 * * 08760000 * RLD DISPLACEMENTS * 08820000 * * 08880000 P EQU 2 P PTR DISPLACEMENT 08940000 R EQU 0 R PTR DISPLACEMENT 09000000 RLDFLG EQU 4 FLAG FIELD 09060000 RLDADR EQU 4 ADDRESS FIELD 09120000 * * 09180000 * DISPLACEMENTS WITHIN OBJECT BUFFER * 09240000 * * 09300000 COL1 EQU 0 09360000 COL5 EQU 4 09420000 COL11 EQU 10 09480000 COL15 EQU 14 09540000 COL29 EQU 12 ADDED TO INFO ADDR TO GET COL. 09600000 * 29 ADDR. 09660000 CQFF EQU X'FF' USED TO TURN OFF INDIC. 09720000 EJECT 09780000 ENTRY IEWLERTN EXTERNAL REFERENCE RESOLUTION 09840000 ENTRY IEWLMAP MAP PROCESSING 09900000 ENTRY IEWLCNVT CONVERSION 09960000 ENTRY IEWLRLD RLD RECORD PROCESSING 10020000 ENTRY IEWLESD ESD RECORD PROCESSING 10080000 ENTRY IEWLEND END OF MODULE PROCESSING 10140000 ENTRY TRANSID TRANSLATE ID ROUTINE 10200000 SAVE (14,12),T,* SAVE REGISTERS 10260000 USING IEWLRELO,BRANCH 10320000 LR BASE,BRANCH SET BASE TO START SA49491 10380000 USING IEWLRELO,BASE ESTABLISH ADDRESSABILITY 10440000 DROP BRANCH 10500000 L SAVEREG,8(SAVEREG) PICK UP NEXT SAVE AREA 10560000 USING IEWLDCOM,CMPTR ESTABLISH ADDR. TO COMM.AREA 10620000 USING ERCODES,0 ERROR CODE DSECT 10680000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 10730000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 10732000 * * 10740000 * GET A RECORD TO PROCESS * 10800000 * * 10860000 RELOREAD L BRANCH,ADREAD 10920000 BALR RETURN,BRANCH GO TO READ A RECORD 10980000 TM CMIOFLGS,CQEOCB END OF CONCATENATION? 11040000 BZ RELO10 NO, PROCESS RECORD 11100000 TM CMRELFLG,CQNOEND WAS AN END CARD RECEIVED 11160000 BO RELO1 YES 11220000 TM CMRELFLG,CQINPUT WAS IT A DUMMY DATA SET 11280000 BZ RELO1 YES,RETURN 11340000 BAL RETURN,IEWLEND GO TO PREFORM CLOSE-OUT PROC. 11400000 BAL RETURN,RERINPTA WARNING--NO END CARD 11460000 RELO1 NI CMRELFLG,CQFF-CQNOEND SET OFF END CARD INDIC. 11520000 L SAVEREG,4(SAVEREG) 11580000 RETURN (14,12),T 11640000 * * 11700000 * SET-UP FOR RECORD PROCESSING * 11760000 * * 11820000 RELO10 L PTR,CMGETREC LOAD ADDR. OF OBJ. BUFFER A30162 11910000 CLI 0(PTR),BLANK CHECK FOR L.E.CONTROL CARD 12000000 BNE RELO20 IT IS NOT A CONTROL CARD 12060000 BAL RETURN,RERINPT8 WARNING-CARD NOT AN OBJ.CARD 12120000 B RELOREAD GO TO READ NEXT RECORD 12180000 RELO20 L ADR,COL5(PTR) LOAD COLS 5 THRU 8 - ADDRESS 12240000 LA ADR,0(ADR) 12300000 LH LNG,COL11(PTR) LOAD COLS 11 AND 12 -BYTE CT 12360000 LH ID,COL15(PTR) LOAD COLS IS AND 16 - ID 12420000 L WORKA,COL1(PTR) LOAD COLS 1 THRU 4-CARD IDENT. 12480000 LA PTR,16(PTR) ADDR. OF COL 17- ADDR.OF INFO 12540000 * * 12600000 * THE FOLLOWING CODE DETERMINES TYPE OF RECORD AND THEN BRANCHES TO * 12660000 * THE APPROPRIATE ROUTINE FOR PROCESSING * 12720000 * * 12780000 LA WORKC,6 GET TABLE ENTRY NUMBER 12840000 LA WORKB,TYPETBLE GET TABLE ADDRESS 12900000 RELO30 LM RETURN,BRANCH,0(WORKB) PICK UP TABLE ENTRY 12960000 CR WORKA,RETURN ARE TYPES EQUAL 13020000 BC 7,RELO40 NO , CONTINUE SEARCH 13080000 OI CMRELFLG,CQINPUT SET INDICATOR FOR VALID INPUT 13100000 * RECEIVED A30162 13120000 BALR RETURN,BRANCH YES, THEN GO TO PROCESS REC. 13140000 B RELOREAD GO TO READ NEXT RECORD 13200000 RELO40 LA WORKB,8(WORKB) UPDATE TABLE PTR 13260000 BCT WORKC,RELO30 LOOP AGAIN 13320000 BAL RETURN,RERINPT9 INVALID INPUT FROM OBJ.MODULE 13380000 B RELOREAD GO TO READ NEXT RECORD 13440000 EJECT 13500000 * * 13560000 ************************** ESD PROCESSOR **************************** 13620000 * * 13680000 * THIS SUBROUTINE CREATES THE CESD FROM THE ESD/CESD SENT TO IT. * 13740000 * IT EXPECTS * 13800000 * #LNG-LENGTH OF ESD INFORMATION * 13860000 * #PTR- ADR. OF ESD INFORMATION * 13920000 * #ID- ID OF FIRST ESD ITEM OTHER THAN LD 13980000 * * 14040000 *********************************************************************** 14100000 IEWLESD EQU * 14160000 STM 14,12,12(13) SAVE REGISTERS 14220000 BALR BASE,0 14280000 USING *,BASE 14340000 L BASE,ABEGIN 14400000 USING IEWLRELO,BASE RESET BASE TO INITIAL VALUE 14460000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 14510000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 14512000 B NESD+8 14520000 NESD DC C'IEWLESD ' 14580000 L SAVEREG,8(SAVEREG) GET NEXT SAVE AREA 14640000 ESDSTART STH ID,CMCURRID SAVE CURRENT ID 14700000 OI CMFLAG4,CQESDS SHOW ESDS RECHD FOR THIS MODULE 14730000 TM CMIOFLGS,CQRECFM IS A LOAD MODULE BEING PROC. 14760000 BO LOADPROC YES 14820000 **** **** 14880000 * INPUT ESD TYPE IS 'NULL' * 14940000 **** **** 15000000 ESD10 TM ETYPE(PTR),WX IS INPUT TYPE WX INC288 15070000 BNO ESD12 NO. BRANCH INC288 15080000 MVI ETYPE(PTR),WEAKCALL+ER YES. SET ER WITH WEAKCALL INC288 15090000 * FLAG ON INC288 15100000 ESD12 TM ETYPE(PTR),NULL IS INPUT ESD TYPE NULL INC288 15110000 BZ CESDSRCH NO, TYPE IS SD - SEARCH CESD 15120000 BC 6,ESD20 NO, CHECK FOR TYPE 'PC' 15180000 ESD15 L CESD,CMNULCHN IS THE CESD NULL ENTRY CREATED 15240000 * ALL NULL ENTRIES ARE RENUMBERED 15300000 * TO THE SAME CESD'DELETE'ENTRY 15360000 LTR CESD,CESD 15420000 BC 7,TRANSLAT YES 15480000 BAL RETURN,CESDENT NO, GET CESD ENTRY 15540000 XC 0(20,CESD),0(CESD) CLEAR ENTRY 15600000 OI CTYPE(CESD),DELETE SET DELETE INDICATOR 15660000 ST CESD,CMNULCHN SAVE CESD ADDR.FOR FUTURE NULLS 15720000 B TRANSLAT GO TO TRANSLATE ID 15780000 ******** ******* 15840000 * INPUT ESD TYPE IS 'PC' * 15900000 ******** ******* 15960000 ESD20 TM ETYPE(PTR),X'03' IS INPUT ESD TYPE 'PC' 16020000 BC 7,ESD35 NO, CHECK FOR 'LD'/'LR' 16080000 ESD30 BAL RETURN,CESDENT GET CESD ENTRY 16140000 BAL RETURN,ENTER MAKE CESD ENTRY 16200000 BAL RETURN,CHECKEP CHECK FOR EP NAME 16260000 B MATERSD2 GO TO TEST LNG.AND MAP 16320000 ******** ******* 16380000 * INPUT ESD TYPE IS 'LR'OR'LD' * 16440000 ******** ******* 16500000 ESD35 TM ETYPE(PTR),CM IS ESD TYPE'LR'OR'LD' 16560000 BC 11,CESDSRCH NO 16620000 TM ETYPE(PTR),PR IS ESD TYPE 'PR' 16680000 BO CESDSRCH YES 16740000 LH ID,EID(PTR) GET 'SD' ID 16800000 OI CMRELFLG,CQESD ESD CALLER INDICATOR 16860000 BAL RETURN,TRANSID TRANSLATE ID 16920000 NI CMRELFLG,CQFF-CQESD SET ESD CALLER INDIC. OFF 16980000 LH ID,CMCURRID RESTORE ID 17040000 LTR PARM,PARM WAS AN INVALID ID FOUND 17100000 BZ NEXTESD YES 17160000 L CESD,0(PARM) GET'SD' CESD ADDR. 17220000 LTR CESD,CESD IS 'SD' DEFINED YET 17280000 BZ ESD40 NO 17340000 ST CESD,ESDADDR(PTR) SAVE 'SD' CESD ADDR. 17400000 B CESDSRCH GO TO SEARCH CESD 17460000 * THE SECTION DEFINITION(SD) FOR A LABEL DEFINITION(LD) MUST BE * 17520000 * DEFINED BEFORE THE LD CAN BE PROCESSED. THEREFORE, ALL LDS WHOSE * 17580000 * SD IS NOT DEFINED WHEN ENCOUNTERED ARE PLACED ON A CHAIN UNTIL * 17640000 * THEIR CORRESPONDING SD IS DEFINED. THE CHAIN IS PROCESSED AT * 17700000 * THE END OF EACH RECORD.(THIS SPECIAL CASE SHOULD OCCUR ONLY IF * 17760000 * THE USER REARRANGES THE OBJECT DECK IN THIS MANNER. * 17820000 ESD40 LR CESD,PTR GET CESD ENTRY ADDR 17880000 SH CESD,CONT4 17940000 TM ETYPE(PTR),LDCHAIN HAS CESD ENTRY BEEN CREATED 18000000 BO ESD50 YES, RECHAIN 18060000 BAL RETURN,CESDENT GET CESD ENTRY 18120000 MVC CNAME(16,CESD),ENAME(PTR) MOVE ESD INFO TO CESD 18180000 ESD50 L WORKC,CMLDCHN 18240000 ST CESD,CMLDCHN 18300000 ST WORKC,0(CESD) CHAIN ENTRY TO 'LD' CHAIN 18360000 B NEXTESD GET NEXT ESD ITEM 18420000 EJECT 18480000 **************************** CESD SEARCH **************************** 18540000 * * 18600000 * THIS ROUTINE SEARCHES THE CESD FOR A GIVEN NAME. IT USES * 18660000 * HIERTBLE TO DETERMINE WHICH CESD CHAINS TO SEARCH AND THEN * 18720000 * GETS THE CHAIN BEGINNING ADDRESSES FROM THE CMTYPCHN TABLE * 18780000 * * 18840000 *********************************************************************** 18900000 CESDSRCH XC CMPREVPT(4),CMPREVPT CLEAR PREVIOUS CHAIN POINTER 18960000 IC WORKA,ETYPE(PTR) GET INPUT ESD TYPE 19020000 N WORKA,TYPEONLY CLEAR ALL BUT TYPE FIELD 19080000 CH WORKA,ONE IS INPUT TYPE 'LD' 19140000 BNE SRCH05 NO 19200000 LA WORKA,3 SET TYPE TO 'LR' 19260000 SRCH05 SLL WORKA,2 19320000 LA WORKA,HIERTBLE(WORKA) CALC HIERTBLE ENTRY ADDR 19380000 SRCH10 IC CESD,0(WORKA) GET CESD TYPE 19440000 N CESD,TYPEONLY CLEAR ALL BUT TYPE 19500000 SLL CESD,2 19560000 LA CESD,CMTYPCHN(CESD) CALC CHAIN TABLE ENTRY ADDR 19620000 SRCH20 L CESD,0(CESD) GET ADDR. OF FIRST ON CHAIN 19680000 LTR CESD,CESD IS THIS END OF CHAIN 19740000 BZ SRCH30 YES 19800000 CLC CNAME(8,CESD),ENAME(PTR) ARE NAMES EQUAL 19860000 BE MATCHED YES, GO TO MATCH PROCESSING 19920000 ST CESD,CMPREVPT SAVE PREVIOUS CHAIN POINTER 19980000 B SRCH20 GET NEXT IN CHAIN 20040000 SRCH30 TM 0(WORKA),X'80' LAST ENTRY IN HIERTBLE 20100000 BO NOMATCH YES, GO TO NO MATCH PROCESSING 20160000 LA WORKA,1(WORKA) UPDATE TO NEXT ENTRY 20220000 XC CMPREVPT(4),CMPREVPT CLEAR PREVIOUS CHAIN POINTER 20280000 B SRCH10 CONTINUE SEARCH 20340000 EJECT 20400000 *********************************************************************** 20460000 * * 20520000 *********************** NO MATCH PROCESSING ************************ 20580000 * * 20640000 *********************************************************************** 20700000 ******** ******* 20760000 * INPUT ESD TYPE IS 'SD' * 20820000 ******** ******* 20880000 NOMATCH EQU * 20940000 TM ETYPE(PTR),NULL IS INPUT ESD TYPE 'SD' 21000000 BZ ESD30 YES, HANDLE SAME AS 'PC' 21060000 BAL RETURN,CESDENT GET CESD ENTRY FOR NOMATCH PROC 21120000 ******** ******* 21180000 * INPUT ESD TYPE IS 'PR' * 21240000 ******** ******* 21300000 TM ETYPE(PTR),PR IS INPUT ESD TYPE 'PR' 21360000 BZ NOMATLD1 NO, TYPE IS'LD' 21420000 BC 6,NOMATCM NO, CHECK FOR 'CM' 21480000 MVC CNAME(16,CESD),ENAME(PTR) YES, MOVE ESD INFO.TO CESD 21540000 XC CTYPE+1(3,CESD),CTYPE+1(CESD) CLEAR RLD CHAIN FIELD 21600000 * CHAIN PR TO END OF PR CHAIN IN 21660000 * ORDER TO MAINTAIN INPUT PR 21720000 * ORDER. 21780000 LA WORKB,CMPRCHN 21840000 L WORKC,CMPRCHN GET ADDRESS OF 1ST PR ENTRY 21900000 NOMATPR1 LTR WORKC,WORKC IS THIS LAST ON CHAIN 21960000 BZ NOMATPR2 YES 22020000 LR WORKB,WORKC NO,SAVE PREVIOUS ENTRY ADDRESS 22080000 L WORKC,0(WORKC) GET ADDR. OF NEXT PR ENTRY 22140000 B NOMATPR1 22200000 NOMATPR2 ST CESD,0(WORKB) CHAIN PR AT END OF CHAIN 22260000 XC 0(4,CESD),0(CESD) CLEAR CHAIN FIELD 22320000 B TRANSLAT GO TO TRANSLATE ID 22380000 ******** ******* 22440000 * INPUT ESD TYPE IS 'CM' * 22500000 ******** ******* 22560000 NOMATCM TM ETYPE(PTR),CM IS TYPE 'CM' 22620000 BC 14,NOMATLD NO 22680000 MVC CTYPE(8,CESD),ETYPE(PTR) KEEP INPUT ADDR.AND LNG. 22740000 LR WORKC,CESD SAVE EXTENDED ENTRY ADDR 22800000 BAL RETURN,CESDENT GET ANOTHER CESD ENTRY 22860000 MVC CNAME(9,CESD),ENAME(PTR) MOVE NAME AND TYPE 22920000 NI CTYPE(CESD),X'07' CLEAR FLAGS EXCEPT TYPE 22980000 XC CTYPE+1(3,CESD),CTYPE+1(CESD) CLEAR ER CHAIN 23040000 ST WORKC,CREL(CESD) SAVE PTR TO EXTENDED ENTRY 23100000 B CHAINING GO TO CHAIN AND TRANSLATE 23160000 ******** ******* 23220000 * INPUT ESD TYPE IS 'LR' OR 'LD' * 23280000 ******** ******* 23340000 NOMATLD TM ETYPE(PTR),LR IS TYPE'LR' 23400000 BM NOMATER NO, TYPE IS 'ER' 23460000 NOMATLD1 L WORKC,ESDADDR(PTR) CESD ADDR OF SD ENTRY 23520000 MVC CNAME(8,CESD),ENAME(PTR) YES, MOVE NAME TO CESD 23580000 TM CTYPE(WORKC),DELETE IS 'SD' FOR 'LR' DELETE 23640000 BZ NOMATLD2 NO 23700000 MVI ETYPE(PTR),ER SET TYPE TO 'ER' 23760000 MVI CTYPE(CESD),ER+DELINK SET CESD TYPE TO ER WITH DELINK 23820000 MVC CREL+1(3,CESD),EADR+1(PTR) SAVE DELINKING FACTOR 23880000 XC CADR+1(3,CESD),CADR+1(CESD) CLEAR RLD CHAIN FIELD 23940000 OI CREL(CESD),X'80' TURN SPEC DELETE BIT ON SA70542 23990021 B CHAINING GO TO CHAIN ENTRY 24000000 NOMATLD2 BAL RETURN,ENTERLR MAKE LR CESD ENTRY 24060000 BAL RETURN,CHECKEP CHECK FOR EP NAME 24120000 BAL RETURN,IEWLMAP GO TO MAKE MAP ENTRY 24180000 B CHAINING GO TO CHAIN AND TRANSLATE 24240000 ******** ******* 24300000 * INPUT ESD TYPE IS 'ER' * 24360000 ******** ******* 24420000 NOMATER MVC CNAME(16,CESD),ENAME(PTR) MOVE ESD INFO. TO CESD ENTRY 24480000 CLI ETYPE(PTR),ERWEAK IS THIS W-CON A39336 24500021 BE NOMATER1 YES, DON'T CLEAR FLAGS A39336 24520021 NI CTYPE(CESD),X'07' CLEAR FLAGS EXCEPT FOR TYPE 24540000 NOMATER1 EQU * INC288 24550000 XC CADR+1(7,CESD),CADR+1(CESD) CLEAR ALL BUT NAME AND TYPE 24600000 CLI ESUBTYP(PTR),X'06' IS ESD MARKED NEVER-CALL 24660000 BNE ENTERCH NO SA62460 24720021 OI CTYPE(CESD),NEVERCAL SET NEVER-CALL INCIC IN CESD'ER' 24780000 ENTERCH LA WORKB,CMERCHN SA62460 24830021 L WORKC,CMERCHN SA62460 24880021 NOMATER2 LTR WORKC,WORKC SA62460 24890021 BZ NOMATER3 SA62460 24892021 LR WORKB,WORKC SA62460 24894021 L WORKC,0(WORKC) SA62460 24896021 B NOMATER2 SA62460 24898021 NOMATER3 ST CESD,0(WORKB) SA62460 24898421 XC 0(4,CESD),0(CESD) SA62460 24898821 B TRANSLAT SA62460 24899221 EJECT 24900000 *********************************************************************** 24960000 ************************** MATCH PROCESSING ************************ 25020000 * * 25080000 *********************************************************************** 25140000 ******** ******* 25200000 * CESD TYPE IS 'SD' --- INPUT ESD TYPE IS 'SD' * 25260000 ******** ******* 25320000 MATCHED EQU * 25380000 TM CTYPE(CESD),NULL IS CESD TYPE 'SD' 25440000 BC 7,MATCHPR NO 25500000 TM ETYPE(PTR),NULL IS INPUT ESD TYPE 'SD' 25560000 BC 7,MATSDER NO 25620000 DELETE1 TM CMFLAG4,CQMOD IS THIS CMPLER-LDED TXT A30142 25630021 BZ DELETE2 NO. WE WON'T READ TEXT 25650000 L WORKC,ELNG(PTR) YES. GET ESD LENGTH 25660000 LA WORKC,0(WORKC) CLEAR HI-ORDER BYTE 25670000 A WORKC,CMMODLNG UPDATE MODULE LENGTH 25680000 LA WORKC,7(WORKC) AND ROUND IT 25690000 N WORKC,DBLWRD 25700000 ST WORKC,CMMODLNG STORE IT BACK 25710000 DELETE2 TM CTYPE(CESD),DELETE IS ORIGINAL DELETE A30142 25715021 BO UPDATERC YES, USE IT A30142 25720021 ST CESD,CMESDSAV SAVE CESD ADDR SA56381 25725021 BAL RETURN,CESDENT GET CESD ENTRY A30142 25730021 MVC CNAME(8,CESD),ENAME(PTR) MOVE NAME AND TYPE A30142 25735021 L WORKC,CMESDSAV GET ORIGINAL'S ADDR SA56381 25740021 L WORKC,CADR(WORKC) INTO WORKC SA49491 25742000 LA WORKC,0(WORKC) A30142 25745021 ST WORKC,CADR(CESD) STORE IT HERE A30142 25750021 L WORKB,EADR(PTR) GET ESD INPUT ADDR A30142 25755021 LA WORKB,0(WORKB) CALC RELOCATION CONSTANT A30142 25760021 SR WORKC,WORKB A30142 25765021 ST WORKC,CREL(CESD) STORE IT A30142 25770021 MVC CTYPE(1,CESD),ETYPE(PTR) SET TYPE A30142 25775021 OI CTYPE(CESD),DELETE SET TO DELETE A30142 25780021 B CHAINING GO TO CHAIN AND TRANSLATE A30142 25785021 ******** ******* 25800000 * CESD TYPE IS 'SD' --- INPUT ESD TYPE IS 'ER' * 25860000 ******** ******* 25920000 MATSDER TM ETYPE(PTR),CM IS INPUT ESD TYPE 'ER' 25980000 BZ TRANSLAT YES,GO TO TRANSLATE 26040000 ******** ******* 26100000 * CESD TYPE IS 'SD' --- INPUT ESD TYPE IS 'CM' * 26160000 ******** ******* 26220000 MATSDCM BO UPDATERC BRANCH IF INPUT TYPE IS CM 26280021 ******** ******* 26340000 * CESD TYPE IS 'SD' --- INPUT ESD TYPE IS 'LD'/'LR' * 26400000 ******** ******* 26460000 MATSDLR L WORKC,ESDADDR(PTR) GET'SD' ADDR 26520000 TM CTYPE(WORKC),DELETE IS'SD' MARKED DELETE 26580000 BO UPDATERC GO TO UPDATE RELOC. CONSTANT 26640000 BAL RETURN,RERINPT4 DUPLIC.SYMBOL-CONFLICTING TYPE 26700000 B UPDATERC GO TO UPDATE RELOC. CONSTANT 26760000 ******** ******* 26820000 * CESD TYPE IS 'PR'---INPUT ESD TYPE IS 'PR' * 26880000 ******** ******* 26940000 MATCHPR TM CTYPE(CESD),PR IS CESD TYPE 'PR' 27000000 BC 14,MATCHCM NO 27060000 BNH MATPRPR1 NO, GO TO CHECK ALIGNMENT 27120000 MVC CLNG+1(3,CESD),ELNG+1(PTR) YES, USE ESD LNG 27180000 MATPRPR1 OC CLNG(1,CESD),ELNG(PTR) SET ALIGN. TO HIGHER VALUE 27240000 B TRANSLAT GO TO TRANSLATE 27300000 ******** ******* 27360000 * CESD TYPE IS 'CM' --- INPUT ESD TYPE IS 'SD' * 27420000 ******** ******* 27480000 MATCHCM TM CTYPE(CESD),CM IS CESD TYPE 'CM' 27540000 BZ MATCHER NO, CESD TYPE IS 'ER' 27600000 BC 6,MATCHLR NO, CESD TYPE IS 'LR' 27660000 TM ETYPE(PTR),NULL YES, IS INPUT ESD TYPE 'SD' 27720000 BC 7,MATCMER NO 27780000 L ADR,CREL(CESD) GET ADDR OF EXTENDED ENTRY 27840000 CLC ELNG+1(3,PTR),CLNG+1(ADR) IS INPUT LNG GT CESD LNG 27900000 BNL MATCMSD1 YES,USE INPUT LNG M5478 27960021 LA ZERO,22 MSG IEW1232 M5453 28010021 LR PARM,PTR PT TO ESD NAME M5453 28060021 L BRANCH,ADERROR ADDR OF ERROR ROUTINE M5453 28070021 BALR RETURN,BRANCH BR TO ERROR ROUTINE M5453 28072021 MATCMSD1 L WORKC,CMESDCHN 28080000 ST ADR,CMESDCHN 28140000 ST WORKC,0(ADR) PUT EXTENDED ENTRY ON FREE CHN. 28200000 B MATERSD0 GO TO HANDLE SAME AS SD-ER 28260000 ******** ******* 28320000 * CESD TYPE IS 'CM' --- INPUT ESD TYPE IS 'ER' * 28380000 ******** ******* 28440000 MATCMER L WORKC,CREL(CESD) GET ADDR OF EXTENDED ENTRY 28500000 MVC CADR+1(3,WORKC),EADR+1(PTR) SAVE INPUT ADDRESS 28560000 TM ETYPE(PTR),CM IS ESD TYPE 'ER' 28620000 BO MATCMCM NO, ESD TYPE IS 'CM' 28680000 BM MATCMLR NO, TYPE IS 'LR' OR 'LD' 28740000 XC CADR+1(3,WORKC),CADR+1(WORKC) MAKE SURE ADDR IS ZERO 28800000 B TRANSLAT GO TO TRANSLATE ID 28860000 ******** ******* 28920000 * CESD TYPE IS 'CM' --- INPUT ESD TYPE IS 'LR'/'LD' * 28980000 ******** ******* 29040000 MATCMLR L WORKC,ESDADDR(PTR) GET 'SD' ADDR 29100000 TM CTYPE(WORKC),DELETE IS'SD' DELETE 29160000 BO TRANSLAT YES 29220000 BAL RETURN,RERINPT4 DUPLIC.SYMBOL-CONFLICTING TYPE 29280000 B TRANSLAT GO TO TRANSLATE 29340000 ******** ******* 29400000 * CESD TYPE IS 'CM' --- INPUT ESD TYPE IS 'CM' * 29460000 ******** ******* 29520000 MATCMCM CLC CLNG+1(3,WORKC),ELNG+1(PTR) IS CESD LNG BT ESD LNG 29580000 BH TRANSLAT YES, USE CESD LNG 29640000 MVC CLNG+1(3,WORKC),ELNG+1(PTR) USE ESD LENGTH 29700000 B TRANSLAT GO TO TRANSLATE 29760000 ******** ******* 29820000 * CESD TYPE IS 'LR' ---INPUT ESD TYPE IS 'SD' * 29880000 ******** ******* 29940000 MATCHLR TM ETYPE(PTR),NULL IS ESD TYPE 'SD' 30000000 BC 7,MATLRER NO 30060000 B DELETE1 YES. GO TO DELETE 30150000 ******** ******* 30240000 * CESD TYPE IS 'LR'--- INPUT ESD TYPE IS 'ER' * 30300000 ******** ******* 30360000 MATLRER TM ETYPE(PTR),CM IS ESD TYPE 'ER' 30420000 BZ TRANSLAT YES, GO TO TRANSLATE 30480000 ******** ******* 30540000 * CESD TYPE IS 'LR' --- INPUT ESD TYPE IS 'LR'/'LD' * 30600000 ******** ******* 30660000 MATLRLR BC 6,MATSDLR HANDLE SAME AS 'SD'-'LR'MATCH 30720000 ******** ******* 30780000 * CESD TYPE IS 'LR' --- INPUT ESD TYPE IS 'CM' * 30840000 ******** ******* 30900000 BAL RETURN,RERINPT4 DUPLIC.SYMBOL-CONFLICTING TYPE 30960000 B UPDATERC GO TO UPDATE RELOC.CONSTANT 31020000 ******** ******* 31080000 * CESD TYPE IS 'ER' --- INPUT ESD TYPE IS 'SD' * 31140000 ******** ******* 31200000 MATCHER TM ETYPE(PTR),NULL IS INPUT ESD TYPE 'SD' 31260000 BC 7,MATERLR NO 31320000 MATERSD0 L WORKB,CMPREVPT GET ADDR OF PREV ENTRY ON CHAIN 31380000 L WORKC,0(CESD) 31440000 LTR WORKB,WORKB IS MATCH FIRST ON CHAIN 31500000 BZ MATERSD5 YES 31560000 ST WORKC,0(WORKB) DECHAIN ENTRY 31620000 MATERSD1 L PARM,CADR(CESD) GET ADDR. OF RLD CHAIN 31680000 LA PARM,0(PARM) CLEAR TYPE FIELD 31740000 BAL RETURN,ENTER GO TO MAKE CESD ENTRY 31800000 BAL RETURN,CHECKEP CHECK FOR EP NAME 31860000 BAL RETURN,IEWLERTN GO TO RESOLVE RLD CHAIN 31920000 MATERSD2 L WORKC,ELNG(PTR) GET ESD LENGTH 31980000 LA WORKC,0(WORKC) CLEAR HIGH ORDER BYTE 32040000 LTR WORKC,WORKC IS LNG EQUAL TO ZERO 32100000 BC 7,MATERSD3 NO 32160000 OI CMRELFLG,CQNOLNG YES, SET NOLENGTH INDICATOR 32220000 OI CTYPE(CESD),NOLEN SET NOLENGTH INDICATOR 27445 32250000 B MATERSD4 32280000 MATERSD3 A WORKC,CMMODLNG 32340000 ST WORKC,CMMODLNG UPDATE ACCUM. LENGTH 32400000 MATERSD4 BAL RETURN,IEWLMAP GO TO MAKE MAP ENTRY 32460000 B CHAINING GO TO CHAIN AND TRANSLATE 32520000 MATERSD5 TM CTYPE(CESD),CM IS 'CM' TO BE DECHAINED 32580000 BO MATERSD6 YES 32640000 ST WORKC,CMERCHN DECHAIN 'ER' 32700000 B MATERSD1 32760000 MATERSD6 ST WORKC,CMCMCHN DECHAIN 'CM' 32820000 B MATERSD1 32880000 ******** ******* 32940000 * CESD TYPE IS 'ER' --- INPUT ESD TYPE IS 'LD'/'LR' * 33000000 ******** ******* 33060000 MATERLR TM ETYPE(PTR),CM IS INPUT ESD TYPE'LD'OR'LR' 33120000 BZ MATERER NO, TYPE IS 'ER' 33180000 BO MATERCM NO, TYPE IS 'CM' 33240000 L PARM,CADR(CESD) GET ADDR. OF RLD CHAIN 33300000 LA PARM,0(PARM) CLEAR TYPE FIELD 33360000 LA RETURN,MATERLR2 SET RETURN ADDR FOR ENTERLR RTN 33420000 L WORKC,ESDADDR(PTR) GET 'SD' CESD ADDR 33480000 NI CREL(CESD),X'7F' TURN OFF DELETE BIT SA70542 33530021 TM CTYPE(WORKC),DELETE IS 'SD' FOR 'LR' DELETE SA70542 33532021 BZ ENTERLR NO,CONTINUE SA70542 33534021 OI CREL(CESD),X'80' TURN SPEC DELETE BIT ON SA70542 33536021 MVC CREL+1(3,CESD),EADR+1(PTR) SAVE DELINKING FACTOR SA70542 33538021 B TRANSLAT GO TO TRANSLATE ID SA70542 33538421 ENTERLR L WORKB,EADR(PTR) GET INPUT ADDR 33540000 LA WORKB,0(WORKB) 33600000 LR WORKA,WORKB SAVE FOR RC CALC. 33660000 A WORKB,CREL(WORKC) CALC. LOADER ASSIGNED ADDR(LAA) 33720000 ST WORKB,CADR(CESD) PUT IN CESD ENTRY 33780000 TM CMFLAG4,CQMOD IS THIS COMPILER-LOADED TEXT 33800000 BO MATERLR1 YES. DON'T WORRY 33820000 CL WORKB,CMLOWTBL HAVE TABLES BEEN EXCEEDED 33840000 BNH MATERLR1 NO 33900000 B RERSIZE2 PROGRAM TOO LARGE--ABORT 33960000 MATERLR1 MVI CTYPE(CESD),LR SET TYPE TO 'LR' 34020000 SR WORKB,WORKA CALC RELOCATION CONSTANT 34080000 ST WORKB,CREL(CESD) PUT RC IN CESD ENTRY 34140000 BR RETURN 34200000 MATERLR2 BAL RETURN,IEWLERTN GO TO RESOLVE RLD CHAIN 34260000 BAL RETURN,CHECKEP CHECK FOR EP NAME 34320000 BAL RETURN,IEWLMAP GO TO MAKE MAP ENTRY 34380000 B DECHAIN GO TO DECHAIN'ER',CHAIN 'LR', 34440000 * AND TRANSLATE ID 34500000 ******** ******* 34560000 * CESD TYPE IS 'ER' --- INPUT ESD TYPE IS 'CM' * 34620000 ******** ******* 34680000 MATERCM LR WORKC,CESD SAVE CESD ADDR OF 'ER' 34740000 BAL RETURN,CESDENT GET CESD ENTRY FOR EXTENDED ENT 34800000 MVC CADR(8,CESD),EADR(PTR) MOVE TYPE,ADDR.AND LNG 34860000 ST CESD,CREL(WORKC) SAVE PTR TO EXTENDED ENTRY 34920000 LR CESD,WORKC RESTORE CESD ADDR OF 'ER' 34980000 MVI CTYPE(CESD),CM SET TYPE TO 'CM' 35040000 B DECHAIN GO TO DECHAIN'ER',CHAIN'CM' 35100000 * AND TRANSLATE ID 35160000 ******** ******* 35220000 * CESD TYPE IS 'ER' --- INPUT ESD TYPE IS 'ER' * 35280000 ******** ******* 35340000 MATERER CLI CTYPE(CESD),ER+DELINK IS ER MARKED DELINK 35400000 BNE MATERER2 NO 35460000 NI CTYPE(CESD),X'FF'-DELINK SET DELINK INDIC OFF 35520000 XC CREL(4,CESD),CREL(CESD) CLEAR DELINK FIELD SA70542 35580021 MATERER2 TM ETYPE(PTR),WEAKCALL IS WEAKCALL FLAG ON INC288 35650000 BO MATERER3 YES. LEAVE CESD AS IS INC288 35660000 NI CTYPE(CESD),X'FF'-WEAKCALL NO. MAKE SURE INC288 35670000 * WX IS OFF INC288 35680000 MATERER3 CLI ESUBTYP(PTR),X'06' IS ESD MARKED NEVCAL INC288 35690000 BNE TRANSLAT NO, GO TO TRANSLATE ID 35700000 OI CTYPE(CESD),NEVERCAL SET NEVERCALL INDIC.IN CESD'ER' 35760000 B TRANSLAT GO TO TRANSLATE ID 35820000 EJECT 35880000 ******** ******* 35940000 * THIS ROUTINE DECHAINS CESD ENTRIES WHEN THEIR TYPE CHANGES * 36000000 ******** ******* 36060000 DECHAIN L WORKB,CMPREVPT GET ADDR.OF PREV.ENTRY ON CHAIN 36120000 L WORKC,0(CESD) GET ADDR.OF NEXT ENTRY ON CHAIN 36180000 LTR WORKB,WORKB IS MATCH FIRST ON CHAIN 36240000 BZ DECHAIN1 YES 36300000 ST WORKC,0(WORKB) DECHAIN ENTRY 36360000 B CHAINING 36420000 DECHAIN1 ST WORKC,CMERCHN DECHAIN FIRST 'ER' ENTRY 36480000 ******** ******* 36540000 * THIS ROUTINE CHAINS CESD ENTRIES ACCORDING TO TYPE * 36600000 ******** ******* 36660000 CHAINING IC WORKC,CTYPE(CESD) GET CESD TYPE 36720000 N WORKC,TYPEONLY 36780000 SLL WORKC,2 36840000 LA WORKC,CMTYPCHN(WORKC) CALC ADDR OF CHAIN TABLE 36900000 L WORKB,0(WORKC) 36960000 ST CESD,0(WORKC) CHAIN NEW CESD ENTRY 37020000 ST WORKB,0(CESD) 37080000 ******** ******* 37140000 * THIS ROUTINE MAKES A TRANSLATION TABLE ENTRY * 37200000 ******** ******* 37260000 TRANSLAT TM ETYPE(PTR),X'06' IS INPUT TYPE 'LD' 37320000 BC 7,TRANS10 NO, GO TO TRANSLATE ID. 37380000 TM ETYPE(PTR),LD 37440000 BO NEXTESD YES,DON'T TRANSLATE 37500000 TRANS10 OI CMRELFLG,CQESD YES, SET ESD CALLER INDICATOR 37560000 BAL RETURN,TRANSID GO TO TRANSLATE ID 37620000 NI CMRELFLG,CQFF-CQESD SET OFF ESD CALLER INDICATOR 37680000 LTR PARM,PARM WAS BAD ID ENCOUNTERED 37740000 BZ NEXTESD YES, GET NEXT ESD ITEM 37800000 ST CESD,0(PARM) MAKE TRANSLATION TABLE ENTRY 37860000 TM ETYPE(PTR),X'05' IS ESD TYPE 'ER' 37920000 BC 7,NEXTESD NO 37980000 TM ETYPE(PTR),X'02' 38040000 BZ NEXTESD ' NO 38100000 OI 0(PARM),ERMATCH YES, SET INDIC FOR ABS. FACTOR 38160000 * IF AN 'A'TYPE ADCON IS 38220000 * USED TO REFERENCE THIS 38280000 * EXTERNAL REFERENCE, THE 38340000 * LOADER ASSIGNED ADDR.MUST 38400000 * BE USED FOR RELOCATION 38460000 * INSTEAD OF THE NORMAL 38520000 * RELATIVE RELOCATION FACTOR 38580000 ******** ******** 38640000 * THIS ROUTINE PREPARES TO PROCESS THE NEXT ESD IF THERE IS ONE * 38700000 ******** ******** 38760000 NEXTESD TM ETYPE(PTR),X'06' IS INPUT ESD TYPE'LD' 38820000 BC 7,NEXT10 NO 38880000 TM ETYPE(PTR),LD 38940000 BO NEXT20 YES, DON'T UPDATE ID 39000000 NEXT10 LA ID,1(ID) UPDATE ID 39060000 NEXT20 LA PTR,16(PTR) UPDATE INPUT RECORD PTR 39120000 SH LNG,CONT16 39180000 BP ESDSTART GO TO PROCESS NEXT ESD 39240000 ******** ******* 39360000 * THIS ROUTINE DOES END OF RECORD PROCESSING FOR THE LD CHAIN,IF IT * 39420000 * EXISTS. THIS CHAIN CONSISTS OF LDS WHOSE SD WAS NOT DEFINED WHEN* 39480000 * THE LD WAS PROCESSED. * 39540000 ******** ******* 39600000 LDRTN L PTR,CMLDCHN GET BEGINNING OF 'LD' CHAIN 39660000 LTR PTR,PTR IS THERE AN LD CHAIN 39720000 BZ LD20 NO 39780000 TM CTYPE(PTR),LDCHAIN HAS CHAIN BEEN PROCESSED FOR 39840000 * THIS RECORD 39900000 BZ LD10 NO 39960000 NI CTYPE(PTR),X'FF'-LDCHAIN TURN OFF PROCESSED INDIC 40020000 B ESDEND BRANCH TO RETURN 40080000 LD10 L WORKB,0(PTR) DECHAIN LD ENTRY 40140000 ST WORKB,CMLDCHN 40200000 LA LNG,16 SET ESD LENGTH TO ONE ENTRY 40260000 OI CTYPE(PTR),LDCHAIN SET PROCESSED THIS RECORD INDIC 40320000 LA PTR,4(PTR) POINT TO ESD ITEM 40380000 B ESD35 40440000 LD20 TM CMLIBFLG,CQCESDR IS THIS END OF CESD PROCESSING 40500000 BZ CESDEND YES,CONTINUE END OF CESD PROC. 40560000 ESDEND L SAVEREG,4(SAVEREG) RESTORE SAVE AREA PTR 40620000 RETURN (14,12),T 40680000 EJECT 40740000 ********************** SPECIAL LOAD MODULE PROCESSING **************** 40800000 * THIS ROUTINE SETS ASIDE ALL PC,SD,AND LR CESD TYPES FOR A LOAD * 40860000 * MODULE AND THEN PROCESSES THEM AT END OF CESD. THIS IS NEEDED* 40920000 * BECAUSE SOME LOAD MODULES ARE NOT ASSIGNED ADDRESSES ACCORDING* 40980000 * TO THE ORDER IN THE CESD. * 41040000 *********************************************************************** 41100000 LOADPROC TM CMLIBFLG,CQCESDR IS THIS END OF CESD 41160000 BZ CESDEND YES,GO TO END OF CESD PROCESS 41220000 TM ETYPE(PTR),NULL IS TYPE SD,PC OR LR 41280000 BO ESD15 TYPE IS NULL 41340000 BZ LOAD20 TYPE IS SD 41400000 TM ETYPE(PTR),LR 41460000 BC 6,ESD10 TYPE IS CM,PR,OR ER 41520000 BZ LOAD10 TYPE IS PC 41580000 OI CMCURRID,X'80' IDENTIFY TYPE AS LR 41640000 B LOAD20 41700000 LOAD10 TM ETYPE(PTR),X'10' IS PC DELETE(ENTAB-SEGTAB) 41760000 BO ESD15 GO TO PROCESS AS NULL 41820000 LOAD20 BAL RETURN,CESDENT GET CESD ENTRY 41880000 MVC CNAME(16,CESD),ENAME(PTR) MOVE INFO.TO CESD ENTRY 41940000 MVC CTYPE+2(3,CESD),EADR+1(PTR) CREATE SPECIAL ENTRY FOR ID 42000000 MVC CTYPE(2,CESD),CMCURRID MOVE ID AND TYPE TO CESD ENTRY 42060000 NI CMCURRID,X'7F' CLEAR LR INDIC 42120000 LA WORKA,CMLOADCH SET AS PREVIOUS CHAIN ADDR 42180000 L WORKC,CMLOADCH GET BEGINNING CHAIN ADDR 42240000 LOAD25 LA WORKC,0(WORKC) CLEAR SEGMENT NUMBER 42300000 LTR WORKC,WORKC IS THIS END OF CHAIN 42360000 BZ LOAD45 YES,GO TO CHAIN ENTRY 42420000 CLC ESEGNO(1,PTR),0(WORKC) COMPARE SEGMENT NUMBERS 42480000 BL LOAD45 CHAIN BEFORE 42540000 BH LOAD30 CONTINUE SEARCH 42600000 CLC EADR+1(3,PTR),CADR+2(WORKC) COMPARE ADDRESSES 42660000 BE LOAD40 ADDR. EQUAL 42720000 BL LOAD45 INPUT ADDR. LT EXISTING ADDR. 42780000 LOAD30 LR WORKA,WORKC SAVE AS RPEVIOUS CHAIN ADDR 42840000 L WORKC,0(WORKC) GET NEXT ENTRY FROM CHAIN 42900000 B LOAD25 CONTINUE SEARCH 42960000 LOAD40 TM ETYPE(PTR),X'03' CHAIN LRS AFTER SDS,PCS A59776 43020021 BO LOAD30 TYPE IS LR. CONT SEARCH A59776 43080021 LOAD45 LR WORKC,WORKA CHAIN BEFORE MATCHED ENTRY 43140000 LOAD50 L WORKB,0(WORKC) CHAIN AFTER MATCHED ENTRY 43200000 ST WORKB,0(CESD) 43260000 MVC 0(1,CESD),ESEGNO(PTR) ENTER SEGMENT NUMBER 43320000 ST CESD,0(WORKC) 43380000 SRL WORKB,24 RIGHT ADJUST SEGMENT NUMBER 43440000 STC WORKB,0(WORKC) PRESERVE SEGMENT NUMBER 43500000 B NEXTESD GET NEXT ESD 43560000 CESDEND L WORKC,CMTEMPCH GET ADDR.OF FREE LOAD CHN.ENTRY 43620000 LTR WORKC,WORKC IS THERE A LOAD CH ENTRY TO FREE 43680000 BZ CESDEND0 NO 43740000 L WORKB,CMESDCHN YES,CHAIN IT TO FREE ESD CHAIN 43800000 ST WORKC,CMESDCHN 43860000 ST WORKB,0(WORKC) 43920000 XC CMTEMPCH(4),CMTEMPCH CLEAR CHAIN POINTER 43980000 CESDEND0 L PTR,CMLOADCH GET NEXT ESD 44040000 LA PTR,0(PTR) CLEAR SEGMENT NUMBER 44100000 LTR PTR,PTR ANY ENTRIES ON CHAIN 44160000 BZ ESDEND NO, RETURN TO CALLER 44220000 LA LNG,16 SET LENGTH EQ TO ONE ESD ENTRY 44280000 LH ID,CTYPE(PTR) GET ID 44340000 MVC CADR+1(3,PTR),CADR+2(PTR) READJUST INPUT ADDR FIELD 44400000 MVI CREL(PTR),X'00' CLEAR HIGH BYTE OF R.C. 44460000 TM CTYPE(PTR),X'80' IS TYPE'LR' 44520000 BZ CESDEND1 NO 44580000 SLL ID,17 YES, ZERO HIGH ORDER BITS OF ID 44640000 SRL ID,17 44700000 MVI CTYPE(PTR),LR SET TYPE TO 'LR' 44760000 B CESDEND2 44820000 CESDEND1 MVI CTYPE(PTR),SD SET TYPE TO 'SD' 44880000 CLI CNAME(PTR),C' ' IS TYPE 'PC' 44940000 BNE CESDEND2 NO 45000000 MVI CTYPE(PTR),PC SET TYPE TO 'PC' 45060000 CESDEND2 L WORKC,0(PTR) TAKE ENTRY OFF LOAD CHAIN 45120000 LA WORKC,0(WORKC) CLEAR SEGMENT NUMBER 45180000 ST WORKC,CMLOADCH 45240000 LA PTR,0(PTR) CLEAR SEGMENT NUMBER 45300000 ST PTR,CMTEMPCH SAVE ESD PTR TO FREE AFTER PROC. 45360000 LA PTR,4(PTR) UPDATE PAST CHAIN FIELD 45420000 STH ID,CMCURRID SAVE ID 45480000 B ESD10 GO TO PROCESS ESD 45540000 EJECT 45600000 ******************** CESD ENTRY ALLOCATION ************************** 45660000 * * 45720000 * THIS SUBROUTINE GETS A CESD ENTRY FROM CESD FREE ENTRIES CHAIN * 45780000 * OR CALLS THE ALLOCATE ROUTINE FOR ALLOCATION OF ONE ENTRY * 45840000 * THE ENTRY ADDRESS IS RETURNED IN #PARM AND #CESD * 45900000 * * 45960000 *********************************************************************** 46020000 CESDENT STM 14,1,12(13) SAVE REGISTERS 14-1 46080000 L PARM,CMESDCHN GET BEGINNING OF FREE CESD CHN 46140000 LTR PARM,PARM IS IT EMPTY 46200000 BC 7,CESDDCHN NO 46260000 LA ZERO,20 SET ENTRY LENGTH 46320000 BAL RETURN,ALLOCATE GO TO ALLOCATE A CESD ENTRY 46380000 CESDRTRN LM 14,0,12(13) YES,RESTORE REGS. 14-0 46440000 LR CESD,PARM 46500000 BR RETURN RETURN 46560000 CESDDCHN L ZERO,0(PARM) DECHAIN ENTRY FROM FREE CHAIN 46620000 ST ZERO,CMESDCHN 46680000 B CESDRTRN GO TO RETURN 46740000 EJECT 46800000 ********************** MAKE CESD ENTRY FOR PC AND SD **************** 46860000 * #CESD-ADDR.OF CESD ENTRY * 46920000 * #PTR-ADDR.OF INPUT ESD ITEM * 46980000 *********************************************************************** 47040000 ENTER MVC CNAME(8,CESD),ENAME(PTR) MOVE NAME TO CESD 47100000 L WORKC,CMMODLNG GET ACCUM. LENGTH 47160000 LA WORKC,7(WORKC) 47220000 N WORKC,DBLWRD ROUND TO DOUBLE WORD 47280000 ST WORKC,CMMODLNG SAVE ROUNDED LENGTH 47340000 TM CMFLAG4,CQMOD IS THIS COMPILER-LOADED TEXT 47360000 BZ ENTER05 NO 47380000 A WORKC,CMCORE1 YES. USE COMPILER-ASSIGNED ADR 47400000 B ENTER10 47420000 ENTER05 A WORKC,CMNXTTXT CALCUATE NEXT CSECT ADDRESS 47440000 CL WORKC,CMLOWTBL HAS CORE BEEN EXCEEDED 47460000 BH RERSIZE2 YES,PROGRAM TOO LARGE-ABORT 47520000 ENTER10 ST WORKC,CADR(CESD) LOADER ASSIGNED ADDR TO CESD 47580000 MVC CTYPE(1,CESD),ETYPE(PTR) MOVE FLAG FIELD TO CESD 47640000 NI CTYPE(CESD),X'07' CLEAR FLAGS EXCEPT FOR TYPE 47700000 L WORKB,EADR(PTR) GET INPUT ADDR. 47760000 LA WORKB,0(WORKB) CLEAR HIGH ORDER BYTES 47820000 SR WORKC,WORKB RELOC.VALUE=LAA-INPUT ADDR 47880000 ST WORKC,CREL(CESD) RELOC.VALUE TO CESD 47940000 BR RETURN RETURN 48000000 EJECT 48060000 ******** ******* 48120000 * THIS ROUTINE UPDATE THE RELOCATION CONSTANT,THEN GOES TO TRANSLAT* 48180000 ******** ******* 48240000 UPDATERC L WORKC,EADR(PTR) GET ESD INPUT ADDR. 48300000 LA WORKC,0(WORKC) 48360000 L WORKB,CADR(CESD) GET LOADER ASSIGNED ADDR. 48420000 LA WORKB,0(WORKB) 48480000 SR WORKB,WORKC CALC. RELOCATION CONSTANT 48540000 ST WORKB,CREL(CESD) UPDATE RC. 48600000 B TRANSLAT GO TO TRANSLATE 48660000 EJECT 48720000 ******** ******* 48780000 * CHECK FOR ENTRY POINT NAME * 48840000 ******** ******* 48900000 CHECKEP TM CMPRMFLG,CQEPNAME+CQEPADDR HAS ENTRY PT.BEEN DEFINED 48960000 BCR 9,RETURN YES OR AN ENTRY POINT WAS NOT 49020000 * SPECIFIED 49080000 TM CMPRMFLG,CQEPNAME WAS A NAME DEFINED 49140000 BCR 8,RETURN NO,RETURN 49200000 CLC CMEPNAME(8),CNAME(CESD) IS CURRENT CESD THE ENTRY POINT 49260000 BCR 7,RETURN NO 49320000 MVC CMEPADDR+1(3),CADR+1(CESD) YES, SAVE EP ADDR 49380000 OI CMPRMFLG,CQEPADDR SET EP ADDR DEFINED INDICATOR 49440000 BR RETURN 49500000 EJECT 49560000 *************************** TEXT PROCESSOR ************************** 49620000 * * 49680000 * THIS ROUTINE LOADS TEXT INTO MAIN STORAGE. IT EXPECTS THE * 49740000 * FOLLOWING REGISTER CONTENT: * 49800000 * * 49860000 * #ID - TEXT ID * 49920000 * #ADR- DISPLACEMENT ADDR OF TEXT * 49980000 * #LNG- LENGTH OF TEXT * 50040000 * #PTR- ADDRESS OF TEXT IN BUFFER * 50100000 * * 50160000 *********************************************************************** 50220000 IEWLTXT LTR LNG,LNG IS THERE ANY TEXT 50280000 BZ RELOREAD NO, GO TO READ NEXT RECORD 50340000 TM CMFLAG4,CQMOD WAS MOD RECORD ALSO RECEIVED 50360000 BO RELOREAD IGNORE THIS TEXT 50380000 BAL RETURN,TRANSID CONVERT ID TO TRANS.TABLE ADDR 50400000 LTR PARM,PARM WAS CONVERSION POSSIBLE 50460000 BZ RELOREAD NO,BAD ID ENCOUNTERED 50520000 TXT10 TM CTYPE(CESD),DELETE SHOULD TEXT BE DELETED 50580000 BO RELOREAD TEXT IS DELETE,GO TO READ 50640000 OI CMLIBFLG,CQNOTXT SET TEXT RECEIVED INDICATOR 50700000 TM CTYPE(CESD),NOLEN WAS THIS ZERO-LENGTH CSECT 27445 50720000 BNO TXT20 NO 27445 50740000 OI CMRELFLG,CQNOLNTX SHOW TEXT WAS RECEIVED 27445 50760000 TXT20 A ADR,CREL(CESD) CALC MAIN STORAGE TEXT ADR 27445 50780000 LA WORKC,0(LNG,ADR) CALC END TEXT ADDR. 50820000 CL WORKC,CMLOWTBL WILL TEXT OVERLAP TABLES 50880000 BH RERSIZE2 YES,PROGRAM TOO LARGE--ABORT 50940000 BCTR LNG,0 51000000 EX LNG,MOVE2 MOVE TEXT INTO MAIN STORAGE 51060000 LA ADR,1(ADR,LNG) CALC. EXTENT OF TEXT ADDED 51120000 CL ADR,CMLSTTXT IS HIGHEST TEXT ADDR.EXCEEDED 51180000 BNH RELOREAD NO 51240000 ST ADR,CMLSTTXT UPDATE HIGHEST TXT ADDR 51300000 B RELOREAD GO TO READ NEXT RECORD 51360000 EJECT 51361000 ****************************MOD PROCESSOR****************************** 51362000 * * 51363000 * THIS ROUTINE PICKS UP ORIGIN AND EXTENT INFORMATION * 51364000 * FOR COMPILER-LOADED TEXT FROM MOD CARDS PASSED THROUGH AN * 51365000 * INCORE DATA SET. IT EXPECTS THE FOLLOWING REGISTER CONTENT * 51366000 * * 51367000 * #LNG - LENGTH OF INFO * 51368000 * #PTR - ADDRESS OF INFO IN BUFFER * 51369000 * * 51370000 *********************************************************************** 51371000 IEWLMOD TM CMFLAG3,CQINCORE IS THIS INCORE DATA SET 51372000 BZ RELOREAD NO. IGNORE IT 51373000 TM CMFLAG4,CQESDS ESD CARDS ALREADY RECEIVED 51374000 BNZ RELOREAD YES. IGNORE THIS THEN 51375000 LTR LNG,LNG ANY MOD INFO 51376000 BZ RELOREAD NO. IGNORE IT 51377000 OI CMLIBFLG,CQNOTXT SET TEXT RECEIVED 51378000 OI CMFLAG4,CQMOD SET MOD RECEIVED 51379000 L WORKC,0(PTR) GET ORIGIN OF TEXT 51380000 LTR WORKC,WORKC WAS IT SPECIFIED 51381000 BZ MODEXTNT NO. SEE IF EXTENTS DEFINED 51382000 MOD10 ST WORKC,CMCORE1 SAVE ORIGIN OF TEXT 51383000 L WORKC,4(PTR) GET LAST ADDRESS 51384000 ST WORKC,CMCORE2 SAVE IT 51385000 MODEXTNT LA WORKC,8 SEE IF THERE'S EXTENT INFO 51386000 SR LNG,WORKC IS LENGTH GREATER THAN 8 51387000 BNP RELOREAD NO. BRANCH 51388000 MODEXT LA ZERO,12 GET THREE WORDS TO SAVE 51389000 BAL RETURN,ALLOCATE EXTENT INFO IN 51390000 L WORKC,CMLOWTBL FIND ADDRESS 51391000 MVC 0(4,WORKC),CMXLCHN CHAIN IT 51392000 MVC CMXLCHN(4),CMLOWTBL TO OTHER EXTENTS 51393000 MVC 4(8,WORKC),8(PTR) MOVE IN EXTENT INFO 51394000 LH WORKC,CMNUMXS PICK UP NUMBER OF EXTENTS 51395000 TM CMPRMFLG,CQEPNAME+CQEPADDR HAS ENTRY POINT BEEN DEF 51396000 BNZ MODEXT1 YES. 51397000 LTR WORKC,WORKC NO. IS THIS FIRST EXTENT 51398000 BNZ MODEXT1 NO 51399000 MVC CMEPADDR(4),8(PTR) YES. USE IT AS ENTRY POINT 51400000 MODEXT1 LA WORKC,1(WORKC) ADD AN EXTENT 51401000 STH WORKC,CMNUMXS TO TOTAL 51402000 B RELOREAD GO GET ANOTHER RECORD 51411000 EJECT 51420000 ************************* RLD PROCESSOR *************************** 51480000 * * 51540000 * THIS SUBROUTINE RELOCATES ADDRESS CONSTANTS USING THE RELOCATION * 51600000 * DICTIONARY (RLDS) ENTRIES SENT IT. IF RELOCATION IS NOT * 51660000 * POSSIBLE, THE RLDS ARE CHAINED OFF OF THE R PTR CESD ENTRY. * 51720000 * IT EXPECTS: * 51780000 * #PTR-POINTER TO RLD INFORMATION * 51840000 * #LNG-LENGTH OF RLD INFORMATION * 51900000 *********************************************************************** 51960000 IEWLRLD EQU * 52020000 STM 14,12,12(13) SAVE REGISTERS 52080000 RLDBASE BALR BASE,0 52140000 USING *,BASE 52200000 L BASE,ABEGIN 52260000 USING IEWLRELO,BASE RESET BASE TO INITIAL VALUE 52320000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 52370000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 52372000 B NRLD+8 52380000 NRLD DC C'IEWLRLD ' 52440000 L SAVEREG,8(SAVEREG) PICK UP NEXT SAVE AREA ADDR. 52500000 RLD10 LTR LNG,LNG ARE ALL RLDS PROCESSED 52560000 BC 2,RLD30 NO. 52620000 RLD19 L SAVEREG,4(SAVEREG) RESTORE SAVE AREA PTR 52680000 RETURN (14,12),T 52740000 * * 52800000 * CHECK VALIDITY OF P PTR * 52860000 * * 52920000 RLD30 TM CMRELFLG,CQENTRY IS THIS THE ENTRY POINT RLD 52980000 BO RLD35 YES 53040000 LH ID,P(PTR) GET P PTR 53100000 BAL RETURN,TRANSID GET TRANS. TABLE ENTRY ADDR 53160000 LTR PARM,PARM WAS TRANSLATION POSSIBLE 53220000 BZ RLD65 NO 53280000 L WORKA,0(PARM) GET CESD ENTRY ADDR 53340000 TM CTYPE(WORKA),DELETE IS CSECT MARKED DELETE 53400000 BO RLD65 YES 53460000 TM RLDFLG(PTR),ACCUMPR IS RLD CXD PSEUDO REG. TYPE 53520000 BO RLD40 YES 53580000 * * 53640000 * CHECK VALIDITY OF R PTR * 53700000 * * 53760000 RLD35 LH ID,R(PTR) GET R PTR 53820000 BAL RETURN,TRANSID GET TRANS, TABLE ENTRY ADDR 53880000 LTR PARM,PARM WAS TRANSLATION POSSIBLE 53940000 BZ RLD65 NO 54000000 * * 54060000 * RELOCATE ADCON ADDRESS - MAKE RLD TABLE ENTRY * 54120000 * * 54180000 RLD40 L PARM,CMRLDCHN GET BEG.ADDR OF FREE RLD TABLE 54240000 * ENTRIES 54300000 LTR PARM,PARM IS IT EMPTY 54360000 BC 7,RLD45 NO 54420000 LA ZERO,8 YES, INDICATE ENTRY SIZE 54480000 BAL RETURN,ALLOCATE GO TO ALLOCATE ENTRY 54540000 B RLD48 NO, CONTINUE PROCESSING 54600000 RLD45 L ZERO,0(PARM) DECHAIN ENTRY FROM FREE CHAIN 54660000 ST ZERO,CMRLDCHN 54720000 RLD48 L WORKB,RLDADR(PTR) 54780000 LA WORKB,0(WORKB) 54840000 A WORKB,CREL(WORKA) CALC. ADCON ADDRESS 54900000 ST WORKB,4(PARM) SAVE ADCON ADDRESS IN RLD TABLE 54960000 TM RLDFLG(PTR),ACCUMPR IS RLD CXD PSEUDO REG. TYPE 55020000 BO RLD100 YES 55080000 MVC 4(1,PARM),RLDFLG(PTR) SAVE FLAG FIELD IN RLD TABLE 55140000 LTR CESD,CESD IS ABSOLUTE FACTOR NEEDED 55200000 BC 11,RLD49 NO 55260000 OI 4(PARM),ERMATCH USE ABSOLUTE FACTOR 55320000 * * 55380000 * CHECK R PTR TYPE --- RELOCATE RLD OR CHAIN IT TO CESD ENTRY * 55440000 * * 55500000 RLD49 TM CTYPE(CESD),LR R PTR TYPE IS SD,PC,OR LR 55560000 BM RLD70 NO 55620000 XC 0(4,PARM),0(PARM) CLEAR CHAIN FIELD 55680000 BAL RETURN,IEWLERTN GO TO RELOCATE RLD 55740000 RLD50 TM RLDFLG(PTR),CONT IS NEXT RLD ITEM CHAINED 55800000 BC 14,RLD60 NO, GO TO GET NEXT R-P PTR 55860000 * * 55920000 * UPDATE TO NEXT FA FIELD * 55980000 * * 56040000 LA PTR,4(PTR) UPDATE TO NEXT FA FIELD 56100000 SH LNG,CONT4 56160000 CH LNG,CONT4 ARE ANY RLDS LEFT 56220000 BH RLD40 YES, GO TO PROCESS NEXT RLD 56280000 BAL RETURN,RERINPT9 INVALID INPUT FROM OBJ MODULE 56340000 B RLD19 RETURN 56400000 * * 56460000 * UPDATE TO NEXT R-P PTR * 56520000 * * 56580000 RLD60 LA PTR,8(PTR) UPDATE RLD PTR 56640000 SH LNG,CONT8 DECR. LENGTH 56700000 B RLD10 GO TO PROCESS NEXT R-P PTR 56760000 RLD65 TM RLDFLG(PTR),CONT NEXT ITEM CHAINED 56820000 BZ RLD60 NO 56880000 LA PTR,4(PTR) UPDATE POINTER 56940000 SH LNG,CONT4 57000000 LTR LNG,LNG HAS RECORD END BEEN REACHED 57060000 BC 2,RLD65 NO, CONTINUE SEARCH FOR R-P 57120000 B RLD19 YES, RETURN TO CALLER 57180000 * * 57240000 * R PTR TYPE IS CM,PR,OR ER - CHAIN RLD TO CESD ENTRY * 57300000 * * 57360000 RLD70 TM CTYPE(CESD),CM IS CESD TYPE COMMON 57420000 BO RLD75 YES 57480000 BZ RLD72 NO, CESD TYPE IS ER 57540000 OI 4(PARM),PRRLD CESD TYPE IS 'PR',SET PR FLAG 57600000 B RLD80 57660000 * PRECEDING CODING TO MARK RLD AS 57720000 * DISPLACEMENT PR IS INCLUDED 57780000 * BECAUSE THE ASSEMBLER PUTS OUT 57840000 * NON-BRANCH RLDS FOR Q-TYPE 57900000 * ADDRESS CONSTANTS 57960000 RLD72 TM CTYPE(CESD),DELINK DOES RLD NEED DELINKING 58020000 BZ RLD80 NO 58080000 RLD75 OI CMRELFLG,CQDELINK SET SPECIAL RELOCATION INDIC. 58140000 BAL RETURN,IEWLERTN GO TO DELINK ADCON 58200000 RLD80 L WORKC,CADR(CESD) 58260000 ST PARM,CADR(CESD) 58320000 ST WORKC,0(PARM) CHAIN RLD TO CESD ENTRY 58380000 MVC CADR(1,CESD),0(PARM) PRESERVE TYPE INDIC 58440000 MVI 0(PARM),X'00' CLEAR TYPE FROM CHAIN ADDR 58500000 B RLD50 GO TO CHECK IF NEXT R-P OR ADDR 58560000 * * 58620000 * RLD IS CXD PSEUDO REGISTER TYPE * 58680000 * * 58740000 RLD100 L WORKB,CMCXDPT CHAIN ACCUM PSEUDO REGISTER 58800000 ST PARM,CMCXDPT 58860000 ST WORKB,0(PARM) 58920000 B RLD50 GO TO CHECK IF NEXT R-P OR ADDR 58980000 EJECT 59040000 **************************** END PROCESSOR ************************** 59100000 * * 59160000 * THIS ROUTINE PROCESSES THE END CARD FOR LENGTH AND ENTRY POINT. * 59220000 * IT ALSO CLEARS THE TRANSLATION TABLE. IT EXPECTS: * 59280000 * #ID - CONTAINS ID OF ASSEMBLED ADDR. ENTRY * 59340000 * #PTR- ADDR OF SYMBOLIC ENTRY POINT NAME * 59400000 * #ADR- ENTRY POINT ADDRESS IF PRESENT * 59460000 * * 59520000 *********************************************************************** 59580000 IEWLEND EQU * 59640000 STM 14,12,12(13) SAVE REGISTERS 59700000 BALR BASE,0 59760000 USING *,BASE 59820000 L BASE,ABEGIN 59880000 USING IEWLRELO,BASE RESET BASE TO INITIAL VALUE 59940000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 59990000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 59992000 B NEND+8 60000000 NEND DC C'IEWLEND ' 60060000 L SAVEREG,8(SAVEREG) PICK UP NEXT SAVE AREA 60120000 TM CMIOFLGS,CQEOCB+CQRECFM IS THIS END OF MODULE PROCESS 60180000 BC 7,ENDLNG YES 60240000 OI CMRELFLG,CQNOEND SET END CARD RECEIVED INDIC 60300000 L WORKB,CMLDCHN GET START OF 'LD' CHAIN 60360000 LTR WORKB,WORKB IS 'LD' CHAIN EMPTY 60420000 BZ ENDEPCHK YES 60480000 BAL RETURN,RERINPT7 INVALID ID ON 'LD' ENTRY 60540000 ENDEPCHK TM CMPRMFLG,CQEPNAME+CQEPADDR HAS ENTRY POINT BEEN DEFINED 60600000 BZ ENDENTRY NO 60660000 ******** ********** 60720000 * DEFINE CSECT LENGTH AND MODULE EXTENT * 60780000 ******** ********** 60840000 ENDLNG L WORKA,CMNXTTXT GET MODULE START ADDR 60900000 TM CMFLAG4,CQMOD IS THIS COMPILER-LOADED TEXT 60910000 BZ END05 NO 60920000 BAL RETURN,SWITCH SWITCH LIMIT ADDRESSES 60930000 END05 EQU * 60940000 TM CMRELFLG,CQNOLNG WAS LENGTH ALREADY SPECIFIED 60960000 BZ END19 YES 61020000 TM CMRELFLG,CQNOEND WAS END CARD MISSING 61080000 BZ END12 YES 61140000 END10 L LNG,COL29(PTR) GET LENGTH FIELD 61200000 CLI COL29(PTR),X'00' IS LENGTH ON END CARD 61260000 BE END13 YES 61320000 END12 TM CMRELFLG,CQNOLNTX WAS TEXT RECEIVED 27445 61350000 BNO END12A NO. CSECT WITH LNG ZERO OKAY 27445 61380000 BAL RETURN,RERINPT2 YES. ERROR 27445 61410000 END12A EQU * SA49491 61440021 SR LNG,LNG CSECT LENGTH 0 SA49491 61490021 C LNG,CMMODLNG MORE THAN ONE CSECT? SA49491 61550021 BL END12B MULT CSECTS, ONE ZERO SA49491 61552021 L WORKA,CMLSTTXT USE CMLSTTXT SA49491 61554021 B END20 SA49491 61560021 END12B EQU * SA49491 61570021 L LNG,CMMODLNG USE CMMODLNG SA49491 61580021 L WORKA,CMOBJST GET BEGINING ADDRESS SA58095 61590021 B END20 SA49491 61600021 END13 EQU * SA49491 61610021 A LNG,CMMODLNG UPDATE NEW ACCUM LENGTH SA49491 61660021 ST LNG,CMMODLNG STORE IT BACK SA49491 61710021 A LNG,CMOBJST COMPUTE HIGH ADDRESS SA58095 61712021 CL LNG,CMLSTTXT ACCUM GREATER THAN TXT? SA58095 61720021 L LNG,CMMODLNG RESTORE LNG REGISTER SA49491 61722021 BH END20 YES, GO USE IT SA49491 61730021 L WORKA,CMNXTTXT GET LENGTH SA49491 61732021 ST WORKA,CMOBJST SAVE IT SA49491 61734021 B END20 GO CALCULATE MODULE LNG SA49491 61736021 END19 L LNG,CMMODLNG NO,USE ACCUM MODULE LNG 61740000 END20 AR WORKA,LNG CALC. PROGRAM HIGHEST ADDR. 61800000 LA WORKA,7(WORKA) 61860000 N WORKA,DBLWRD UPDATE TO DBLE. WORD BOUNDARY 61920000 CL WORKA,CMLSTTXT HAS TEXT EXCEEDED SPECIFIED LNG 61980000 BNL END25 NO 62040000 L WORKA,CMLSTTXT YES,USE ACTUAL TEXT LENGTH 62100000 LA WORKA,7(WORKA) ROUND OFF TO A47048 62150021 N WORKA,DBLWRD DOUBLEWORD BOUNDARY A47048 62152021 BAL RETURN,RERINPT2 ERROR,TXT RECEIVED EXCEEDS LNG 62160000 END25 ST WORKA,CMNXTTXT UPDATE NEXT TEXT ADDRESS 62220000 ST WORKA,CMOBJST SAVE AMOUNT IN OBJST SA49491 62270021 ST WORKA,CMLSTTXT INITIAL TEXT POINTER 62280000 TM CMFLAG4,CQMOD IS THERE INCORE TEXT 62290000 BZ END26 NO 62300000 BAL RETURN,SWITCH 62310000 END26 EQU * 62320000 CL WORKA,CMHITBL HAS CORE EXTENT BEEN EXCEEDED 62340000 BNH ENDTRCLR NO 62400000 B RERSIZE2 PROGRAM TOO LARGE--ABORT 62460000 SWITCH L WORKB,CMCORE1 SWITCH ADDRESSES 62466000 ST WORKA,CMCORE1 FOR COMPILER-LOADED TEXT 62472000 ST WORKB,CMNXTTXT 62478000 ST WORKB,CMOBJST SAVE IT SA49491 62480021 L WORKA,CMCORE2 62484000 L WORKB,CMLSTTXT 62490000 ST WORKA,CMLSTTXT 62496000 ST WORKA,CMLSTTXT 62502000 ST WORKB,CMCORE2 62508000 BR RETURN 62514000 ******** ******* 62520000 * CLEAR TRANSLATION TABLE * 62580000 ******** ******* 62640000 ENDTRCLR LA WORKC,CQMAXEXT NO. OF TRANS. TABLE EXTENTS 62700000 BCTR WORKC,0 62760000 SLL WORKC,2 CALC. DISP INTO TRANS. CTRL.TBL 62820000 LA WORKB,CMTRCTRL ADDR. OF TRANS.CTRL. TABLE 62880000 LH WORKA,NEG4 62940000 ENDCLEAR L PTR,0(WORKB,WORKC) GET ADDR OF EXTENT 63000000 LTR PTR,PTR HAS EXTENT BEEN ALLOCATED 63060000 BZ ENDLOOP NO 63120000 XC 0(CQEXTSIZ,PTR),0(PTR) CLEAR EXTENT 63180000 ENDLOOP BXH WORKC,WORKA,ENDCLEAR DECR-TEST-LOOP OR CONTINUE 63240000 XC CMMODLNG(4),CMMODLNG CLEAR MODULE LENGTH 63300000 NI CMRELFLG,CQNOEND+CQLIB CLEAR FLAGS 63360000 NI CMFLAG4,X'FF'-CQESDS-CQMOD SET FLAGS 0 63390000 L SAVEREG,4(SAVEREG) RESTORE SAVE AREA PTR 63420000 RETURN (14,12),T 63480000 ******** ******* 63540000 * ENTRY POINT DEFINITION * 63600000 ******** ******* 63660000 ENDENTRY CH ID,BLNK+2 IS ID PRESENT 63720000 BE ENDSYM NO 63780000 CL ADR,BLNK HAS ADDR.BEEN SPECIFIED 63840000 BNE END100 YES 63900000 SR ADR,ADR NO, SET ADDR TO ZERO 63960000 END100 ST ADR,CMEPADDR SAVE ENTRY POINT ADDR. 64020000 BAL RETURN,TRANSID CONVERT ID TO TRANS.TABLE ADDR 64080000 LTR PARM,PARM WAS TRANSLATION POSSIBLE 64140000 BZ ENDLNG NO 64200000 LA WORKC,CMEPADDR CREATE RLD FOR EP 64260000 ST WORKC,CMEPNAME+4 64320000 MVI CMEPNAME+4,X'0C' SET FLAG FIELD FOR EP RLD 64380000 STH ID,CMEPNAME SAVE R PTR FOR EP RLD 64440000 XC CMEPCESD(4),CMEPCESD SET RELOC VALUE TO ZERO 64500000 LA WORKA,CMEPCESD-16 SIMULATE P PTR CESD ADDR 64560000 LA LNG,8 GET LENGTH OF RLD ENTRY 64620000 LR WORKC,PTR SAVE BUFFER POINTER 64680000 LA PTR,CMEPNAME GET ADDR OF RLD ENTRY 64740000 OI CMRELFLG,CQENTRY SET INDIC NOT TO TRANS P PTR 64800000 BAL RETURN,IEWLRLD GO TO PROCESS RLD FOR EP 64860000 LR PTR,WORKC RESTORE BUFFER POINTER 64920000 ENDADDR ST CESD,CMEPCESD SAVE ENTRY POINT CESD ADDR 64980000 OI CMPRMFLG,CQEPADDR SET EP ADDR RECEIVED 65040000 B ENDLNG 65100000 ENDSYM CLI 0(PTR),BLANK IS NAME ON END CARD 65160000 BE ENDLNG NO 65220000 MVC CMEPNAME(8),0(PTR) SAVE ENTRY POINT NAME 65280000 OI CMPRMFLG,CQEPNAME SET EP NAME RECEIVED 65340000 * * 65400000 * CHECK IF ENTRY POINT NAME DEFINED YET * 65460000 * * 65520000 L WORKC,CMSDCHN CHECK 'SD' CHAIN 65580000 LA RETURN,ENDLRCHN 65640000 ENDEP LTR WORKC,WORKC IS THIS END OF CHAIN 65700000 BCR 8,RETURN YES 65760000 CLC CNAME(8,WORKC),CMEPNAME CHECK FOR ENTRY POINT NAME 65820000 BE ENDEPADR 65880000 L WORKC,0(WORKC) UPDATE TO NEXT ENTRY 65940000 B ENDEP 66000000 ENDLRCHN LA RETURN,ENDLNG SET RETURN REGISTER 66060000 L WORKC,CMLRCHN GET BEGINNING OF LR CHAIN 66120000 B ENDEP GO TO SEARCH CHAIN 66180000 ENDEPADR MVC CMEPADDR+1(3),CADR+1(WORKC) SAVE ENTRY POINT ADDR. 66240000 OI CMPRMFLG,CQEPADDR SET INDICATOR FOR EP ADDR 66300000 B ENDLNG GO TO CHECK LENGTH 66360000 EJECT 66420000 *********************** TABLE ALLOCATION ROUTINE ******************** 66480000 * * 66540000 * THIS ROUTINE ALLOCATES TABLE EXTENTS AND RETURNS THE ENTRY ADDR. * 66600000 * IN #PARM. #ZERO MUST CONTAIN EXTENT SIZE ON ENTRY. * 66660000 * * 66720000 *********************************************************************** 66780000 ALLOCATE EQU * 66840000 L PARM,CMLOWTBL ADDR OF LOWEST USED TABLE ADDR 66900000 SR PARM,ZERO 66960000 C PARM,CMLSTTXT HAVE TABLES OVERLAPPED TEXT 67020000 BNL ALLOC 67080000 B RERSIZE2 PROGRAM TOO LARGE--ABORT 67140000 ALLOC ST PARM,CMLOWTBL UPDATE LOWEST TABLE ADDRESS 67200000 BR RETURN RETURN 67260000 EJECT 67320000 ************************** TRANSLATE ROUTINE ************************ 67380000 * * 67440000 * THIS SUBROUTINE TRANSLATES THE ESD ID TO A CORRESPONDING ENTRY * 67500000 * ADDRESS IN THE TRANSLATE TABLE. #ID MUST CONTAIN THE ESD ID. * 67560000 * THE LOW ORDER BIT OF CMRELFLG SHOULD BE SET TO INDICATE WHETHER * 67620000 * THE TRANSLATION TABLE ENTRY SHOULD EXIST OR NOT * 67680000 * THE ENTRY ADDRESS IS RETURNED IN #PARM. IF BAD ID,#PARM= 0. * 67740000 * THE CONTENTS OF THE ENTRY(CESD ADDR) ARE RETURNED IN #CESD IF * 67800000 * REQUESTED BY CQESD FLAG * 67860000 *********************************************************************** 67920000 TRANSID EQU * 67980000 STM 14,12,12(13) SAVE REGISTERS 68040000 BALR BASE,0 68100000 USING *,BASE 68160000 L BASE,ABEGIN 68220000 USING IEWLRELO,BASE RESET BASE TO INITIAL VALUE 68280000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 68330000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 68332000 B NTRAN+8 68340000 NTRAN DC C'TRANSID ' 68400000 L SAVEREG,8(SAVEREG) GET NEXT SAVE AREA 68460000 LTR ID,ID IS ID EQ TO 0 68520000 BZ TRBADID YES-ERROR 68580000 LA ZERO,CQEXTSIZ NO.OF TRANSLATE EXTENT ENTRIES 68640000 LA WORKA,CQMAXEXT MAX. NO. OF EXTENTS 68700000 SR WORKC,WORKC CLEAR EVEN DIVIDE REGISTER 68760000 DR WORKC,ZERO CALC.TRANSLATE CTRL ENTRY NO. 68820000 CR ID,WORKA HAS EXTENT BEEN ALLOCATED 68880000 BNL TRANSERR NO 68940000 SLL ID,2 CALC DISP 69000000 LA ID,CMTRCTRL(ID) CALC TRANSLATE CTRL ENTRY ADDR 69060000 L PARM,0(ID) 69120000 LTR PARM,PARM HAS THE EXTENT BEEN ALLOCATED 69180000 BC 7,CALCADDR YES, GO TO CALC ADDR 69240000 TM CMRELFLG,CQESD ERROR OR ALLOCATE MORE 69300000 BZ TRBADID ERROR-BAD ID 69360000 LA ZERO,CQEXTSIZ*4 SIZE OF EXTENT 69420000 BAL RETURN,ALLOCATE GO TO ALLOCATE EXTENT 69480000 ST PARM,0(ID) PUT EXTENT ADDR IN CTRL TABLE 69540000 XC 0(CQEXTSIZ*4,PARM),0(PARM) CLEAR TRANSLATION TABLE ENTRY 69600000 CALCADDR SLL WORKC,2 69660000 AR PARM,WORKC CALC TRANSLATE ENTRY ADDR 69720000 TM CMRELFLG,CQESD SHOULD ESD BE DEFINED 69780000 BO ENDALLOC NO 69840000 L CESD,0(PARM) YES,CHECK IF IT IS DEFINED 69900000 LTR CESD,CESD 69960000 BZ TRBADID ERROR, IT IS NOT DEFINED 70020000 ENDALLOC L SAVEREG,4(SAVEREG) RESTORE REGISTERS 70080000 LM 2,8,28(13) PRESERVE REGISTER 1 AND 9 70140000 LM 10,12,60(13) 70200000 L 14,12(13) 70260000 MVI 12(13),X'FF' FLAG SAVE AREA 70320000 BR RETURN RETURN 70380000 TRANSERR TM CMRELFLG,CQESD TABLE OVERFLOW OR BAD ID 70440000 BZ TRBADID BAD ID 70500000 B RERSIZE3 TRANS.TABLE SIZE EXCEEDED 70560000 TRBADID BAL RETURN,RERINPT7 INVALID ID 70620000 SR PARM,PARM CLEAR PARM REG. 70680000 B ENDALLOC RETURN TO CALLER 70740000 EJECT 70800000 ******************** EXTERNAL REFERENCE RESOLUTION *************** 70860000 * * 70920000 * THIS SUBROUTINE RELOCATES ALL RLDS ON A CHAIN, THEN RETURNS. WHEN * 70980000 * ENTERED #PARM-MUST CONTAIN THE STARTING ADDR.OF THE ER CHAIN * 71040000 * #CESD-MUST CONTAIN THE CESD ENTRY ADDR TO BE USED FOR * 71100000 * RELOCATION (R PTR ENTRY) * 71160000 * * 71220000 *********************************************************************** 71280000 IEWLERTN EQU * 71340000 STM 14,12,12(13) SAVE REGISTERS 71400000 RESOLVER BALR BASE,0 71460000 USING *,BASE 71520000 L BASE,ABEGIN 71580000 USING IEWLRELO,BASE RESET BASE TO INITIAL VALUE 71640000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 71690000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 71692000 B NERTN+8 71700000 NERTN DC C'IEWLERTN' 71760000 L SAVEREG,8(SAVEREG) GET NEXT SAVE AREA 71820000 ERRTN LTR PARM,PARM IS THIS LAST ON CHAIN 71880000 BC 7,ER5 NO 71940000 ER2 L SAVEREG,4(SAVEREG) RESTORE PTR TO SAVE AREA 72000000 RETURN (14,12),T 72060000 ER5 LA LNG,3 SET LNG OF 4 FOR EX INSTRUCTION 72120000 TM 4(PARM),X'0C' IS THE LENGTH EQ TO 4 72180000 BO ER10 YES 72240000 LA LNG,2 SET LNG OF 3 FOR EX INSTRUCTION 72300000 TM 4(PARM),X'04' IS IT A TWO BYTE ADCON 72360000 BZ ER10 NO,CONTINUE RELOCATION 72420000 LA LNG,1 SET LNG EQ 1 72480000 TM 4(PARM),PRRLD IS IT A VALID 2 BYTE PR 72540000 BO ER10 YES,CONTINUE RELOCATION 72600000 BAL RETURN,RERINPT5 INVALID TWO BYTE ADCON 72660000 * * 72720000 * MOVE ADCON FROM TEXT TO WORK AREA * 72780000 * * 72840000 ER10 L WORKA,4(PARM) GET TEXT ADDR. OF ADCON 72900000 LA WORKA,0(WORKA) CLEAR HIGH ORDER FLAG FIELD 72960000 LA WORKB,CMADCON+3 END ADDR OF ADCON SAVE AREA 73020000 SR WORKB,LNG 73080000 MVI CMADCON,X'00' CLEAR HIGH ORDER BYTE 73140000 EX LNG,MOVEOUT MOVE ADCON TO WORK AREA 73200000 * * 73260000 * TEST TYPE TO DETERMINE WHAT TYPE OF RELOCATION TO PERFORM * 73320000 * * 73380000 TM CMRELFLG,CQDELINK IS DELINKING NEEDED 73440000 BO ER60 YES 73500000 TM 4(PARM),PRRLD IS THIS A PR RLD 73560000 BO ER15 YES, GO FOR ABSOLUTE RELOCATION 73620000 TM 4(PARM),VCON IS ADCON BRANCH TYPE 73680000 BZ ER40 NO, IT IS NON-BRANCH TYPE 73740000 * * 73800000 * ABSOLUTE RELOCATION * 73860000 * * 73920000 ER15 MVC CMADCON(4),CADR(CESD) GET LOADER ASSIGNED ADDRESS 73980000 MVI CMADCON,X'00' CLEAR HIGH ORDER BYTE 74040000 EX LNG,MOVEIN SET ADCON=LOADER ASSIGNED ADDR 74100000 * * 74160000 * PUT RLD ENTRY ON FREE ENTRY CHAIN * 74220000 * * 74280000 ER20 L WORKA,0(PARM) SAVE ER CHAIN PTR 74340000 L WORKB,CMRLDCHN GET START OF CHAIN 74400000 ST WORKB,0(PARM) 74460000 ST PARM,CMRLDCHN ADD ENTRY TO TOP OF CHAIN 74520000 LR PARM,WORKA 74580000 B ERRTN CONTINUE RESOLUTION 74640000 ******** ******* 74700000 * RELATIVE RELOCATION * 74760000 ******** ******* 74820000 ER40 L WORKA,CREL(CESD) GET RELOCATION VALUE 74880000 TM 4(PARM),X'80' IS ABSOLUTE RELOC FACTOR NEEDED 74940000 BZ ER45 NO 75000000 CLI CTYPE(CESD),CM IS THIS COMMON A46172 75020021 BE ER45 YES-ABSOL FACTOR IN CREL A46172 75040021 L WORKA,CADR(CESD) GET ABSOLUTE RELOC FACTOR 75060000 LA WORKA,0(WORKA) 75120000 ER45 TM 4(PARM),X'02' DOES RLD INDICATE SUBT. 75180000 BZ ER50 NO 75240000 LCR WORKA,WORKA COMPLEMENT VALUE 75300000 ER50 A WORKA,CMADCON RELOCATE ADCON 75360000 ST WORKA,CMADCON STORE ADCON VALUE FOR MOVE 75420000 L WORKA,4(PARM) GET TEXT ADDR. FOR ADCON 75480000 EX LNG,MOVEIN MOVE RELOCATED ADCON TO TEXT 75540000 B ER20 75600000 * * 75660000 * SPECIAL DELINKING FOR ADCONS POINTING TO COMMON AREAS. * 75720000 * * 75780000 ER60 L WORKC,CREL(CESD) GET ADDR OF EXTENDED CM ENTRY 75840000 TM CTYPE(CESD),CM DOES WORKC CONTAIN ADDR OF EXT. 75900000 * ENTRY(CM) OR INPUT ADDR(ER) 75960000 BNZ ER65 WORKC CONTAINS INPUT ADDR(ER) 76020021 NI CREL(CESD),X'7F' TURN OFF DELETE BIT SA70542 76070021 B ER70 CONTINUE SA70542 76072021 ER65 EQU * HERE IF COMMON SA70542 76074021 L WORKC,CADR(WORKC) GET INPUT ADDR FOR COMMON 76080000 OI 4(PARM),X'80' SHOW ABS RELO FAC NEEDED A46172 76110021 ER70 LA WORKC,0(WORKC) CLEAR HIGH ORDER BYTE 76140000 L ZERO,CMADCON GET ADCON VALUE 76200000 SR ZERO,WORKC SUBTRACT INPUT ADDR 76260000 ST ZERO,CMADCON 76320000 EX LNG,MOVEIN MOVE DELINKED VALUE BACK TO TXT 76380000 NI CMRELFLG,CQFF-CQDELINK SET DELINK INDICATOR OFF 76440000 B ER2 76500000 EJECT 76560000 ******************************* IEWLMAP ******************************* 76620000 * * 76680000 * THIS SUBROUTINE FORMATS THE MAP PRINT LINE AND USES THE PRINT RTN. * 76740000 * #CESD=ADDR OF CESD ENTRY TO BE MAPPED * 76800000 * * 76860000 ********** ******* 76920000 IEWLMAP EQU * 76980000 STM 14,12,12(13) SAVE REGISTERS 77040000 BALR BASE,0 77100000 USING *,BASE 77160000 L BASE,ABEGIN 77220000 USING IEWLRELO,BASE 77280000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 77330000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 77332000 B NMAP+8 77340000 NMAP DC C'IEWLMAP ' 77400000 TM CMPRMFLG,CQMAP IS MAP OPTION SPECIFIED 77460000 BZ MAPRETRN NO 77520000 L SAVEREG,8(SAVEREG) PICK UP NEXT SAVE AREA 77580000 CLC CMWTBFCT(2),CMMAPLIN IS LINE FULL 77640000 BL MAP20 NO,MAKE ENTRY 77700000 L BRANCH,ADPRINT 77760000 BALR RETURN,BRANCH GO TO PRINT LINE-GET NEW LINE 77820000 MAP20 L PTR,CMPUTREC 77880000 AH PTR,CMWTBFCT CALC NEXT BUFFER ADDR. 77940000 TM CMFLAG4,CQMOD WAS THIS PASSED THROUGH MOD RECORD 77950000 BNO MAP30 NO. CHECK AUTOCALL 77960000 MVC SUFFIXNM(3,PTR),TRISTAR YES. MARK AS PRE-LOADED TEXT 77970000 B MAPNAME 77980000 MAP30 EQU * 77990000 TM CMLIBFLG,CQAUTOC WAS ENTRY CREATED BY AUTOCALL 78000000 BZ MAPNAME NO 78060000 MVI SUFFIXNM(PTR),C'*' YES, MOVE IN LIBRARY DESIGNATOR 78120000 TM CMRELFLG,CQLIB IS RESOLUTION FROM SYSLIB 78180000 BO MAPNAME YES 78240000 MVI SUFFIXNM+1(PTR),C'*' NO,FROM LINK PACK AREA 78300000 MAPNAME MVC NAME(8,PTR),CNAME(CESD) MOVE IN NAME 78360000 TM CTYPE(CESD),NULL IS IT AN 'SD' 78420000 BZ MAPSD YES 78480000 TM CTYPE(CESD),LR IS IT AN 'LR' 78540000 BO MAPLR YES 78600000 BZ MAPPC IT IS 'PC' 78660000 TM CTYPE(CESD),CM IS IT A 'CM' 78720000 BO MAPCM YES 78780000 MAPPR MVC TYPE(2,PTR),PRTYPE IT IS A 'PR',MOVE IN 'PR'TYPE 78840000 B MAPADDR GO TO MAP ADDR 78900000 MAPSD MVC TYPE(2,PTR),SDTYPE IT IS AN 'SD'MOVE IN 'SD' TYPE 78960000 B MAPADDR GO TO CHECK FOR EP NAME 79020000 MAPLR MVC TYPE(2,PTR),LRTYPE IT IS AN 'LR' MOVE IN 'LR'TYPE 79080000 B MAPADDR GO TO CHECK FOR EP NAME 79140000 MAPPC MVC PREFIXNM(13,PTR),PRIVATE IT IS A 'PC',MOVE IN PRIVATE 79200000 B MAPADDR DESIGNATOR 79260000 MAPCM MVC TYPE(2,PTR),CMNTYPE IT IS CM, MOVE IN TYPE 79320000 CLI CNAME(CESD),BLANK IS IT BLANK COMMON 79380000 BNE MAPADDR NO 79440000 MVC PREFIXNM(9,PTR),BLANKCOM MOVE IN BLANK COMMON DESIGNATOR 79500000 MAPADDR L PARM,CADR(CESD) GET ADDR TO BE MAPPED 79560000 BAL 14,IEWLCNVT GO TO CONVERSION ROUTINE 79620000 MVC ADDR(6,PTR),CMXDBLWD+1 MOVE IN CONVERTED ADDR 79680000 LH PARM,CMWTBFCT 79740000 LA PARM,ENTRYSZ(PARM) 79800000 STH PARM,CMWTBFCT UPDATE BUFFER BYTE COUNT 79860000 L SAVEREG,4(SAVEREG) PICK UP LAST SAVE AREA 79920000 MAPRETRN RETURN (14,12),T 79980000 EJECT 80040000 ************************ CONVERSION ROUTINE ************************* 80100000 * * 80160000 * THIS SUBROUTINE CONVERTS A BINARY QUANTITY IN REGISTER 1 TO * 80220000 * PRINT CHARACTERS. THE RESULT IS IN THE COMMUNICATIONS AREA * 80280000 * CMDBLEWD+1. REGISTERS 0 AND 1 DESTROYED * 80340000 * * 80400000 *************** *************************** 80460000 IEWLCNVT EQU * 80520000 BALR BASE,0 80580000 USING *,BASE 80640000 L BASE,ABEGIN 80700000 USING IEWLRELO,BASE RESET BASE TO INITIAL VALUE 80760000 L BASE2,ABEG4096 SET UP SECOND BASE REG SA49491 80810000 USING IEWLRELO+4096,BASE2 ESTABLISH ADDRESSABILITY SA49491 80812000 LA PARM,0(PARM) CLEAR HIGH ORDER BITS 80820000 LTR PARM,PARM TEST FOR ZERO 80880000 BC 7,CVTCONT NO 80940000 MVC CMXDBLWD+1(6),ZEROADDR STORE ZERO 81000000 BR RETURN RETURN 81060000 CVTCONT ST PARM,CMXDBLWD PLACE BINARY QUANTITY IN AREA 81120000 UNPK CMXDBLWD+1(7),CMXDBLWD+1(4) UNPACK BINARY QUANTITY 81180000 MVZ CMXDBLWD+1(6),CMXDBLWD ZERO ZONES FOR TRANSLATE 81240000 TR CMXDBLWD+1(6),TRTABLE TRANSLATE FOR PRINTING 81300000 LA ZERO,1 LOAD INCREMENT 81360000 LA PARM,CMXDBLWD+1 GET ADDR. OF CONVERTED QUANTITY 81420000 HIGHZERO CLI 0(PARM),C'0' TEST FOR ZERO 81480000 BCR 7,RETURN NONE, SO RETURN 81540000 MVI 0(PARM),C' ' REPLACE ZERO WITH BLANK 81600000 BXH PARM,ZERO,HIGHZERO INCR AND LOOP TO NEXT DIGIT 81660000 EJECT 81720000 DS 0F SA70542,SA49491 81730021 * THE FOLLOWING TWO CONSTANTS MUST BE WITHIN THE FIRST 2K SA49491 81770021 ABEGIN DC A(IEWLRELO) USED TO ESTABLISH ADDR. SA49491 81772021 ABEG4096 DC A(IEWLRELO+4096) ADCON FOR SECOND BASE SA49491 81774021 * * 81780000 *********************** ERROR ROUTINES ***************************** 81840000 * * 81900000 RERINPT2 LA ZERO,ERINPT2 INVALID LNG SPECIFIED FOR CSECT 81960000 B ERROR 82020000 RERINPT4 LA ZERO,ERINPT4 DOUBLY DEFINED SYMBOL---- 82080000 LR PARM,PTR CONFLICTING TYPES 82140000 B ERROR 82200000 RERINPT5 LA ZERO,ERINPT5 INVALID TWO-BYTE ADCON 82260000 B ERROR 82320000 RERINPT7 LA ZERO,ERINPT7 INVALID ID 82380000 B ERROR 82440000 RERINPT8 LA ZERO,ERINPT8 CARD PRINTED NOT OBJECT CARD 82500000 B ERR 82560000 RERINPT9 LA ZERO,ERINPT9 INVALID INPUT FROM OBJ. MODULE 82620000 B ERR 82680000 RERINPTA LA ZERO,ERINPT10 WARNING--NO END CARD 82740000 B ERROR 82800000 RERSIZE2 LA ZERO,ERSIZE2 PROGRAM TOO LARGE 82860000 B ERROR 82920000 RERSIZE3 LA ZERO,ERSIZE3 TRANS. TABLE OVERFLOW 82980000 B ERROR CONFLICTING TYPES 83040000 ERR L PARM,CMGETREC GET ADDR.OF BUF.TO BE PRINTED 83100000 TM CMFLAG3,CQINCORE IS THIS INCORE DATA SET 83110000 BZ ERROR NO. GO AHEAD 83120000 OI CMIOFLGS,CQEOFB+CQEOCB YES. SET FLAGS SO WE WON'T READ 83130000 * ANY MORE 83140000 ERROR LR WORKC,RETURN SAVE RETURN REGISTER 83160000 L BRANCH,ADERROR 83220000 BALR RETURN,BRANCH GO TO LOG ERROR 83280000 LR RETURN,WORKC RESTORE RETURN REGISTER 83340000 BR RETURN 83400000 EJECT 83460000 MOVE2 MVC 0(1,ADR),0(PTR) MOVE TEXT FROM REC.TO STORAGE 83520000 MOVEOUT MVC 0(1,WORKB),0(WORKA) MOVE ADCON TO WORK AREA 83580000 MOVEIN MVC 0(1,WORKA),0(WORKB) MOVE ADCON FROM WORK AREA 83640000 DS 0F SA49491 83650000 BLANKCOM DC C'$BLANKCOM' BLANK COMMON DESIGNATOR 85440000 PRIVATE DC C'$PRIVATE PC' PRIVATE CODE DESIGNATOR 85500000 TRTABLE DC C'0123456789ABCDEF' TRANSLATION TABLE 85560000 ZEROADDR DC C' 00' ADDR OR DISP VALUE EQ 0 85620000 TRISTAR DC C'***' FLAG PRE-LOADED TEXT IN MAP 85980000 DS 0F ALIGNMENT 86040000 BLNK DC X'00' BLANK ADDR. ON WORK BOUNDARY 86100000 DC C' ' 86160000 TYPEONLY DC X'00000007' CLEAR ALL BUT TYPE FIELD 86280000 ADPRINT DC V(IEWLPRNT) ADDRESS OF PRINT ROUTINE 86580000 ADERROR DC V(IEWERROR) ADDRESS OF ERROR ROUTINE 86640000 ADREAD DC V(IEWLREAD) ADDRESS OF OBJ.READ ROUTINE 86700000 DS 0F 86872800 * * 86873200 * THIS TABLE IDENTIFIES THE CESD CHAINS TO BE SEARCHED FOR EACH INPUT * 86889900 * ESD TYPE * 86899900 * * 86901900 HIERTBLE EQU * 86903900 DC X'02000583' SD--ER,SD,CM,LR 86905900 DC X'80000000' LD--NEVER SEARCHED 86906300 DC X'00020385' ER--SD,ER,LR,CM 86906400 DC X'02030085' LR--ER,LR,SD,CM 86906500 DC X'80000000' PC--NEVER SEARCHED 86912100 DC X'05020083' CM--CM,ER,SD,LR 86914100 DC X'86000000' PR--PR-------- 86916100 DC X'80000000' NULL-----NEVER SEARCHED 86916500 NEG4 DC H'-4' DECR. FOR TRANS.TABLE CLEARING 86916900 ONE DC H'1' 86917300 CONT4 DC H'4' 86917400 CONT8 DC H'8' 86917500 CONT16 DC H'16' 86917600 DS 0F SA49491 86919600 DBLWRD DC X'FFFFFFF8' MASK TO ZERO LAST 3 BITS 86923200 PRTYPE DC C'PR' USED FOR MAPPING TYPE 86925200 SDTYPE DC C'SD' USED FOR MAPPING TYPE 86927200 CMNTYPE DC C'CM' USED FOR MAPPING TYPE 86927600 LRTYPE DC C'LR' USED FOR MAPPING TYPE 86928000 DS 0F 86928400 TYPETBLE DC X'02' TYPE COMPARISON TABLE 86928500 DC C'TXT' 86928600 DC A(IEWLTXT) TXT PROCESSOR 86928700 DC X'02' 86942900 DC C'RLD' 86952900 DC A(IEWLRLD) RLD PROCESSOR 86954900 DC X'02' 86956900 DC C'ESD' 86957300 DC A(IEWLESD) ESD PROCESSOR 86962000 DC X'02' 86964000 DC C'SYM' 86966000 DC A(RELOREAD) READ REQUEST ROUTINE 86966400 DC X'02' 86966800 DC C'END' 86971500 DC A(IEWLEND) END PROCESSOR 86973500 DC X'02' 86975500 DC C'MOD' 86975900 DC A(IEWLMOD) 86976300 MAINTAIN DS 50F MAINTENANCE AREA 87085800 EJECT 87135800 IEWLDCOM 87185800 END 87235800 ./ ADD SSI=00013377,NAME=IEWLDRGO,SOURCE=0 TITLE 'IEWLCTRL - LOADER CONTROL' 00700000 *********************************************************************** 01400000 * STATUS - CHANGE LEVEL 21.7 * 01700021 * IEWLCTRL DOES THE FOLLOWING - (1) CHECKS CVT TO SEE * 01800000 * IF MVT IS OPERATING, (2) IF MVT,INVOKES IEWLOAD TO * 01900000 * LOAD AND IDENTIFY PROBLEM PROGRAM. IF NOT MVT,INVOKES * 02000000 * IEWLOADR TO LOAD P/P WITHOUT IDENTIFICATION. (3) * 02100000 * IF MVT, ATTACHES PROGRAM. IF NOT MVT, LOADER BRANCHES * 02200000 * AND LINKS TO IT. 02300000 *FUNCTION/OPERATION: IEWLCTRL CONTROLS LINKAGES TO AND FROM THE * 02800000 * PROCESSING PORTION OF THE LOADER AND LINKAGES TO AND FROM THE * 03500000 * OBJECT PROGRAM. * 04200000 *ENTRY POINTS: * 04900000 * IEWLCTRL(IEWLDRGO,LOADER)--VIA EXEC JCL STATEMENT * 05600000 * --VIA LINK,ATTACH,XCTL,OR LOAD/BALR * 06300000 *INPUT: REGISTER 1 MUST POINT TO A VALID PARAMETER LIST ADDRESS * 07000000 * EVENTHOUGH NO PARAMETERS ARE SPECIFIED * 07700000 *OUTPUT:NONE * 08400000 *EXTERNAL ROUTINES: * 09100000 * IEWLOAD - TO LOAD AND IDENTIFY P/P * 09500000 * IEWLOADR - TO LOAD P/P WITHOUT IDENTIFCATION * 09900000 * OBJECT PROGRAM- FOR EXECUTION * 10500000 *EXITS-NORMAL:RETURN TO CALLING PROGRAM VIA REGISTER 14 AFTER OBJECT * 11200000 * PROGRAM EXECUTION * 11900000 * -ERROR: RETURN TO CALLING PROGRAM VIA REGISTER 14 WITH ERROR * 12600000 * SEVERITY CODE RIGHT ADJUSTED IN REGISTER 15 * 13300000 *TABLES/WORK AREAS: NONE * 14000000 *ATTRIBUTES: READ ONLY,REUSABLE,REENTRANT * 14700000 *NOTES: NONE * 15400000 *********************************************************************** 16100000 IEWLCTRL CSECT 16800000 *A809800,927300,930500 A43867 16850021 *A343000,441000,483000,637500,930300 A44270 16900021 *C469000,637500,840000 A44270 17000021 *A286400,809300 A40641 17100021 *A809881 M2702 17150021 * SA53170 17200000 * SA54498 17250000 * SA49491 17300000 * SA53276 17350021 *D343100,I343500,C847500,C850000 SA58076 17400021 BRANCH EQU 15 17500000 RETURN EQU 14 RETURN ADDRESS REGISTER 18200000 SAVEREG EQU 13 ADDRESS REGISTER SAVE AREA 18900000 BASE EQU 12 BASE REGISTER 19600000 PGMPARM EQU 11 OBJ. PROGRAM PARAMETER LIST ADDRESS 20300000 SAVEPARM EQU 10 PARAMETER REGISTER SAVE AREA 21000000 FREEADDR EQU 9 ADDRESS OF STORAGE TO BE FREED 21700000 R8 EQU 8 WORK REGISTER 22400000 CT EQU 7 PARMETER LENGTH 23100000 TEMPSAVE EQU 6 ADDR OF CALLING PROGRAM SAVE AREA 23800000 SAVECT EQU 5 SAVE OBJ. PROGRAM PARM LENGTH 24500000 SAVEPTR EQU 4 SAVE PTR. TO OBJ. PROG. PARMS 25200000 SAVEEP EQU 3 SAVE OBJECT PROGRAM ENTRY POINT 25900000 LDRPARM EQU 2 ADDRESS OF LOADER PARAMETERS 26600000 PARM EQU 1 ADDRESS OF OBJ. PROGRAM PARAMETERS 27300000 ZERO EQU 0 LOAD AND FREEMAIN REGISTER 28000000 EMVT EQU X'10' MVT FLAG IN CVT 28520000 CVTPTR EQU 16 POINTER TO CVT 28580000 CVTDCB EQU X'74' DISPLACEMENT OF MVT FLAG IN CVT 28640000 ABBIT EQU 29 ABEND BIT IN TCB A40641 28660021 ABMASK EQU X'80' FLAG TO TEST ABEND BIT A40641 28680021 SAVE (14,12),T,* 28700021 BALR BASE,0 ESTABLISH ADDRESSIBILITY 29400000 USING *,BASE 30100000 LR SAVEPARM,PARM SAVE PARAMETER REGISTER 30800000 LR TEMPSAVE,SAVEREG SAVE ADDR.OF CALLING PGM. SAVE AREA 31500000 L SAVEPTR,0(PARM) GET PTR TO PARM LIST A53170 31550021 LH CT,0(SAVEPTR) GET LENGTH OF PARM LIST A53170 31600021 LA CT,CTRLEN(CT) ADD IN FIXED LENGTH A53170 31650021 GETMAIN R,LV=(CT) GET FOR SA, ATTCH PARM LIST A53170 32500021 * AND PARAMETER LIST FOR P/P A53170 32550021 LR FREEADDR,PARM SAVE ADDR FOR FREEMAIN 33600000 USING CTRSTOR,FREEADDR 34300000 ST ZERO,GETLEN SAVE LENGTH OF GETMAIN A53170 34350021 MVI GETLEN,X'00' ZERO OUT HIGH ORDER BYTE SA58076 34400021 MVI CTRFLG,X'00' ZERO OUT FLAG BYTE A44270 34600021 ST SAVEREG,4(PARM) FORWARD AND BACKWARD CHAIN SAVEAREAS 35000000 ST PARM,8(SAVEREG) 35700000 LR SAVEREG,PARM ESTABLISH SAVE AREA REGISTER 36400000 ******** ********* 36460000 * TEST FOR MVT OR NON-MVT SYSTEM * 36520000 ******** ********* 36580000 MVC CTRNAM(8),NAMLOAD PLAN TO INVOKE LOADER VIA IEWLOAD 36640000 * IEWLOAD 36700000 LA R8,CVTPTR GET ADDR OF PTR TO CVT 36760000 L R8,0(R8) GET ADDR OF CVT 36820000 TM CVTDCB(R8),EMVT IS THIS MVT SYSTEM 36880000 BO GETLDR YES. BRANCH 36940000 MVI CTRNAM+7,C'R' NO. INVOKE VIA IEWLOADR 37020000 ******** ******** 37100000 * LOAD THE PROCESSING PORTION OF THE LOADER * 37800000 ******** ******** 38500000 GETLDR LOAD EPLOC=CTRNAM LOAD PROCESSING PART OF LOADER 39200000 ******** ******** 39900000 * SET UP PARAMETERS FOR THE LOADER * 40600000 ******** ******** 41300000 LR PARM,SAVEPARM RESTORE PARM REGISTER 42000000 L SAVEPTR,0(PARM) 42700000 LH CT,0(SAVEPTR) GET PARAMETER COUNT 43400000 LR SAVECT,CT SAVE FOR RESIDUAL CT. CALC. 44100000 STH CT,CTRBYT SAVE RESIDUAL COUNT A44270 44400021 LTR CT,CT ARE THERE ANY PARAMETERS 44800000 BZ PROCESS GO TO LOAD PROGRAM 45500000 LOOP CLI 2(SAVEPTR),C'/' IS THIS END OF LOADER PARMS. 46200000 BE PRMSET1 A44270 46900021 LA SAVEPTR,1(SAVEPTR) UPDATE PARM POINTER 47600000 BCT SAVECT,LOOP CONTINUE LOOP 48300000 B PRMSETUP PREPARE TO LOAD PROGRAM A44270 48500021 PRMSET1 OI CTRFLG,X'01' LOADED PROGRAM PARMS A44270 48700021 PRMSETUP L LDRPARM,0(PARM) GET PARM ADDR 49000000 SR CT,SAVECT CALC RESIDUAL COUNT 49700000 STH CT,0(LDRPARM) RESET COUNT FOR LOADER 50400000 ******** ******** 51100000 * GO TO PROCESSING PORTION OF LOADER FOR LOADING * 51800000 ******** ******** 52500000 PROCESS LR BRANCH,ZERO GET ADDRESS OF LOADER 53200000 BALR RETURN,BRANCH 53900000 LR PGMPARM,PARM SAVE ADDRESS OF PARAMETERS 54600000 LR SAVEEP,ZERO SAVE OBJECT PROGRAM ENTRY POINT 55300000 LR CT,BRANCH SAVE RETURN CODE 56000000 ******** ******** 56700000 * FREE CORE OCCUPIED BY PROCESSING PORTION OF THE LOADER * 57400000 ******** ******** 58100000 DELETE EPLOC=CTRNAM FREE SPACE OCCUPIED BY LOADER 58800000 LR BRANCH,CT RESTORE RETURN CODE 59500000 CH BRANCH,FOUR IS CONDITION CODE GT 4 60200000 BNH PARMSET NO. 60400000 CLI CTRNAM+7,C'R' YES. DID WE INVOKE BY IEWLOADR 60600000 BNE CTRLRTRN NO. 60800000 B FR2 YES. 61200000 ******** ******** 61600000 * SET UP PARAMETERS FOR LOADED PROGRAM * 62300000 ******** ******** 63000000 PARMSET EQU * 63300000 LR PARM,SAVEPARM RESTORE PARM REGISTER 63700000 LA LDRPARM,PPARMSAC POINT TO START OF PARM AREA A53170 64400021 * LOADED PROGRAM WILL USE A53170 64450021 O LDRPARM,PPARMSOR SHOW LAST WORD AND A59398 64460021 ST LDRPARM,PPARMS SET UP ADDR OF PARMS A53170 64500021 BCTR SAVECT,0 FORGET SLASH A59398 65100021 STH SAVECT,PPARMSAC STORE LENGTH FOR PP A59398 65800021 LA CT,255 MAXIMUM LENGTH OF MOVE 66500000 LTR SAVECT,SAVECT ANY PARMS FOR OBJ. PROGRAM 67200000 BP CTSETUP YES 67900000 XC 0(2,LDRPARM),0(LDRPARM) SET PARM CT EQ 0 68600000 B EXECUTE GO TO EXECUTE OBJ. PROGRAM 69300000 CTSETUP CH SAVECT,CONT256 ARE THERE MORE THAN 255 BYTES 70000000 BNL MOVEPARM YES 70700000 LR CT,SAVECT NO, USE ACTUAL COUNT 71400000 BCTR CT,0 DECR COUNT FOR EX INST. 72100000 MOVEPARM EX CT,MOVE MOVE PARAMETERS 72800000 SH SAVECT,CONT256 DECR CT BY BYTES MOVED 73500000 LTR SAVECT,SAVECT MORE PARAMETERS TO MOVE 74200000 BNH EXECUTE NO 74900000 AH LDRPARM,CONT256 YES,UPDATE DESTINATION PTR 75600000 AH SAVEPTR,CONT256 UPDATE ORIGINATION PTR 76300000 B CTSETUP GO TO CONTINUE MOVE 77000000 ******** ******** 77700000 * EXECUTE LOADED PROGRAM * 78400000 ******** ******** 79100000 EXECUTE CLI CTRNAM+7,C'R' DID WE INVOKE VIA IEWLOADR 79170000 BNE LINK NO. LINK TO PROGRAM 79240000 LR BRANCH,SAVEEP YES. BRANCH TO LOADER. GET EP 79310000 LA PARM,PPARMS GET ADDRESS OF PARM LIST SM4390 79360021 * FOR PROBLEM PROGRAM INTO SM4390 79370021 * REGISTER ONE SM4390 79372021 BALR RETURN,BRANCH EXECUTE OBJECT PROGRAM 79380000 LR CT,BRANCH SAVE OBJECT PROGRAM RETURN CODE 79450000 EX1 L PARM,8(PGMPARM) GET START OF FIRST EXTENT OF 79458000 * COMPILER-LOADED TEXT 79466000 LTR PARM,PARM IS THERE ANY? 79474000 BZ FR2 NO. 79482000 L ZERO,12(PGMPARM) YES. GET LENGTH 79490000 FREEMAIN R,LV=(0),A=(1) FREE IT 79498000 FR2 EQU * 79506000 L PARM,0(PGMPARM) GET START OF PROGRAM 79520000 L ZERO,4(PGMPARM) GET LENGTH 79590000 FREEMAIN R,LV=(0),A=(1) FREE PROGRAM 79660000 B CTRLRTRN BRANCH TO FREE SAVE AREA 79730000 ******** ****** 79830000 * ATTACH PROBLEM PROGRAM * 79930000 ******** ******* 80030000 LINK MVC CTRATTCH(CTRATTLN),ATTCH MOVE ATTACH LIST IN 80130000 ST PGMPARM,CTRATTCH STORE PTR TO NAME 80230000 SR R8,R8 ZERO OUT 80330000 ST R8,CTRECB ECB. 80430000 LA PARM,PPARMS GET ADDRESS OF PARM LIST SM4390 80480000 * FOR PROBLEM PROGRAM INTO SM4390 80490000 * REGISTER ONE SM4390 80500000 ATTACH ECB=CTRECB,MF=(E,(1)),SF=(E,CTRATTCH),SHSPV=78 SA53276 80530021 ST PARM,CTRTCB SAVE TCB POINTER 80630000 WAIT ECB=CTRECB WAIT FOR P/P TO FINISH 80730000 NI CTRECB,X'3F' ISOLATE RETURN OR COMPLETION CODE 80830000 L CT,CTRECB AND SAVE IT 80930000 L PARM,CTRTCB PICK UP TCB ADDRESS A40641 80940021 TM ABBIT(PARM),ABMASK HAS USER PGM ABENDED A40641 80950021 BZ DETACH NO A40641 80960021 WTO 'IEW199I ERROR - USER PROGRAM HAS ABNORMALLY TERMINATED'X80970021 ,ROUTCDE=(2,11) A40641 80980021 RELTEST EQU * SA54498 80980100 LA R8,CVTPTR GET POINTER SA54498 80980400 L R8,0(R8) TO CVT SA54498 80980500 SH R8,HALF3 BACK UP TO RELEASE LEVEL SA54498 80980600 CLI 0(R8),C'2' RELEASE 20.0 OR HIGHER? SA54498 80983600 BNE AB1 BYPASS EXTRACT IF NOT SA54498 80985600 MVC INITEXTR(EXTRLEN),EXTR MOVE EXTRACT PARM LIST A43867 80988000 LA R8,INITEXAD GET ADDRESS FOR TSO PTR A43867 80991000 ST R8,INITEXTR PUT IT IN LIST A43867 80994000 EXTRACT MF=(E,INITEXTR) POINT TO LIST FORM A43867 80997000 L R8,INITEXAD GET IT A43867 81000000 LTR R8,R8 WAS IT DEFINED A43867 81003000 BZ AB1 NO, BRANCH A43867 81006000 TM 0(R8),TCBTSTSK YES, IT IT TIME-SHARING A43867 81009000 BO DETACH YES A43867 81012000 AB1 L PARM,CTRTCB PICK UP TCB ADDRESS A43867 81015000 L PARM,16(PARM) A43867 81018000 LA PARM,0(PARM) SUPPRESS DUMP M2702 81021000 SVC 13 A43867 81024000 DETACH EQU * A40641 81027000 DETACH CTRTCB DETACH P/P 81030000 ******** ******** 81900000 * FREE SAVE AREA AND ATTCH PARAM LIST 82600000 ******** ******** 83300000 CTRLRTRN EQU * A44270 83500021 TM CTRFLG,X'01' LOADED PROG PARMS? A44270 83700021 BZ CT1 NO A44270 83900021 NI 0(SAVEPARM),X'7F' TURN OFF LAST PARM FLAG A44270 84100021 CT1 L PARM,0(SAVEPARM) A(OPTIONS) A44270 84300021 MVC 0(2,PARM),CTRBYT RESTORE RESIDUAL COUNT A44270 84500021 LR PARM,FREEADDR ADDR OF STORAGE TO BE FREED A44270 84700021 L ZERO,GETLEN GET LENGTH OF GOTTEN CORE SA58076 84750021 FREEMAIN R,LV=(0),A=(1) FREE SA AND PARM LIST SA58076 85000021 LR BRANCH,CT RESTORE OBJECT PROG RETURN CODE 87000021 LR SAVEREG,TEMPSAVE RESTORE CALLING PGM SAVE AREA ADDR. 89600000 RETURN (14,12),T,RC=(15) 90300000 DS 0F ALIGN 90302021 PPARMSOR DC X'80000000' MASK TO SET HIGH ORDER BIT A59398 90310021 HALF3 DC H'3' CONSTANT TO BACK UP CVT PTR SA54498 90350000 FOUR DC H'4' 91000000 CONT256 DC H'256' DECR LENGTH FOR PARM. MOVES 91700000 MOVE MVC 2(1,LDRPARM),3(SAVEPTR) MOVE PARM. FIELD 92400000 NAMLOAD DC CL8'IEWLOAD ' NAME TO INVOKE PROCESSING PORTION BY 92700000 ATTCH ATTACH SF=L ATTACH PARAM LIST 92730000 EXTR EXTRACT EXTR,'S',FIELDS=(TSO),MF=L A43867 92740021 TCBTSTSK EQU X'80' TSO FLAG A43867 92750021 ****** ******* 92760000 * DSECT FOR CTR'S DYNAMIC STORAGE * 92790000 ****** ******* 92820000 CTRSTOR DSECT 92850000 CTRSA DS 18F SAVE AREA 92880000 CTRATTCH ATTACH ECB=CTRECB,SF=L 92910000 CTRATTLN EQU *-CTRATTCH LENGTH OF ATTCH PARAM LIST 92940000 CTRECB DS F ECB FOR P/P TASK 92970000 CTRTCB DS F TCB FOR P/P 93000000 CTRNAM DS CL8 NAME BY WHICH TO INVOKE LOADER 93030000 CTRFLG DS X SPECIAL FLAGS A44270 93040021 CTRBYT DC H'0' FOR RESIDUAL COUNT A44270 93050021 INITEXTR EXTRACT INITEXAD,'S',FIELDS=(TSO),MF=L A43867 93052021 EXTRLEN EQU *-INITEXTR A43867 93054021 INITEXAD DS F EXTRACT WILL PUT ADDR OF A43867 93056021 * TSO FIELD HERE A43867 93058021 GETLEN DS F LENGTH OF GETMAIN WILL A53170 93058421 * BE SAVED HERE A53170 93058821 DS 0D ALIGNMENT FOR PP PARM LIST A53170 93059221 CTRLEN EQU *-CTRSTOR+6 CTR WILL GETMAIN FOR THIS A58736 93060021 * VALUE PLUS THE LENGTH OF A53170 93062021 * PARM LIST PASSED TO LOADER A53170 93064021 * BY THE INVOKING PROGRAM A53170 93066021 PPARMS EQU * PARMS FOR PP WILL BE MOVED A53170 93080021 * HERE FOR ALIGNMENT A53170 93092021 PPARMSAC EQU *+4 ACTUAL POSITION OF START A53170 93094021 * OF PARM LIST FOR LOADED A53170 93096021 * PROGRAM A53170 93098021 END 93100000