./ ADD SSI=01051290,SOURCE=1,NAME=ACCESS MACRO 00090020 ACCESS &PHASE 00180020 .*************************************************************** 00270020 .* 00360020 .* 00450020 .* ACCESS MACRO 00540020 .* 00630020 .* 00720020 .*FUNCTION 00810020 .* WILL ASSEMBLE NECESSARY ACCESS ROUTINES FOR EACH PHASE. 00900020 .* PHASE 1 & 2 GET 'E' AND 'L' SERIES BUT NOT LOCNXT ROUTINE. 00990020 .* PHASE 3 GETS 'L' SERIES AND LOCNXT NOT 'E' SERIES. 01080020 .* 01170020 .*CALLING SEQUENCE 01260020 .* ACCESS PHASE= A ONE DIGIT NUMBER EITHER 1, 2 OR 3 01350020 .* 01440020 .* 01530020 .**************************************************************** 01620020 * TAMER-ACCESS PACKAGE 01710020 * TABLE DICTIONARY AREA IN THIS PACKAGE IS 16K 01800020 * 01890020 * 01980020 * NOTE THAT WHEN A USER STARTS TO BUILD THE DICTIONARY HE MUST FIRST 02070020 * CALL 'INTACC' TO INITIALIZE 'ACCESS'. THIS INITIALIZATION IS NOT 02160020 * NECESSARY IF THE DICTIONARY IS ALL OR PARTIALLY BUILTA. 02250020 * 02340020 * 02430020 * ORDER OF CORE FOR ACCESS 02520020 * LOCATIONS COMMON TO ACCESS AND TAMER 02610020 * LOCATIONS FOR ROUTINES COMMON TO 'ENT' AND 'L' SERIES 02700020 * LOCATIONS FOR 'L' SERIES 02790020 * LOCATIONS FOR 'ENT' SERIES 02880020 * ROUTINES COMMON TO 'ENT' AND 'L' SERIES 02970020 * 'L' SERIES 03060020 * 'ENT' SERIES 03150020 * 03240020 * 03330020 EJECT 03420020 * 03510020 * 03600020 * IMMEDIATE VALUES 03690020 * 03780020 * MASKS DM PREFIX 03870020 DMPFT1 EQU 128 TESTS 1ST BIT OF DICT PREFIX 1000 0000 03960020 DMPFT2 EQU 64 TESTS 2ND BIT OF DICT PREFIX 0100 0000 04050020 DMBYT EQU 255 TESTS WHOLE BYTE 04140020 DMATRB EQU 240 TESTS FIRST 4 BITS 04230020 * 04320020 * MASKS TO TEST ROUTINE ENTERED UPON 04410020 DMEPTR EQU 16 ENTPTR TEST, TESTS 5TH BIT FROM RIGHT 04500020 DMGPTR EQU 8 GETPTR TEST, TESTS 4TH BIT FROM RIGHT 04590020 DMATRP EQU 4 LATRPT, NOTE ALSO FOR LATGRP 04680020 DMACP EQU 8 TESTS FOR LATACP,LATGRP 04770020 DMACPP EQU 12 TESTS FOR LATACP (ALSO WORKS FOR LATRPT) 04860020 DMDELM EQU 16 LDELNM 04950020 DMPFXT EQU 192 TESTS DICT PFX, 1ST 2 BITS 1100 0000 05040020 DMGRUP EQU 4 GROUP TEST, 3RD BIT FROM RIGHT 05130020 * 05220020 * EQUATES GIVING DISPLACEMENTS OF NEEDED PARAMS FROM A(COS),WHICH 05310020 * IS THE START-ADDRESS OF COMPILER COMMON. 05400020 * 05490020 * 05580020 LDICOT EQU TIB20-COS 05670020 L8DCOT EQU TIB20-COS 05760020 * 05850020 * 05940020 * 06030020 * 06120020 * FOLLOWING ARE REGISTER EQUATES FOR TAMER 06210020 * 06300020 * 06390020 * 06480020 BDUMP6 EQU * START OF DEBUG DUMP AREA 06570020 DS 0F 06660020 * ACCESS- TAMER CONSTANTS AND WORK AREA 06750020 * THESE VALUES ARE UNDER REGISTER 12 06840020 * 06930020 * FOLLOWING IS THE TAMER CONSTANT AREA. TIBS AND TAMMS ASSEMBLED 07020020 * HERE ARE ACCESSIBLE TO ACCESS, AND TO THE PHASE PROGRAMMER. 07110020 * 07200020 USING *,R12 BASE REGISTER FOR ACCESS CONSTANTS. 07290020 PBEG12 EQU * MUST FOLLOW 'USING' FOR REG12 07380020 FRSTAM DS 80F 07470020 LASTAM DS D 07560020 DUMMY1 DS F 07650020 * 07740020 ****** PARAMETER LIST FOR STORAGE OF PARAM'S. GOT FROM COMPILER COMMON. 07830020 * 07920020 * 08010020 DPARST DS F STORAGE FOR A(COS)PASSED TO PHASE. 08100020 DPARLS DS 19F STORAGE FOR PARAMS MOVE TO ACCESS 08190020 DMDMDM DS 20F FROM COMMON. 08280020 LPRIME EQU DPARLS A(PRIME) 08370020 LINSRT EQU DPARLS+4 A(INSERT) 08460020 DTAMM1 EQU DPARLS+24 A(LASTAM) 08550020 DMVDAD DC F'0' A(MOVDIC), PASSED IN COMMON,STORED 08640020 * HERE BY INTACC. 08730020 LDUMP6 EQU * END OF DEBUG DUMP AREA 08820020 PTMSTR DS F 08910020 FDCNT DC X'00000090' 09000020 PBCODE DC X'C0DEC0DE' 09090020 ADSTOR DS CL1 09180020 * 09270020 * 09360020 * THE FOLLOWING ARE TAMER ADCONS FOR THE VARIOUS ROUTINE NAMES. 09450020 * 09540020 * 09630020 * 09720020 * 09810020 * 09900020 * FOLLOWING ARE THE ADCONS FOR THE LAST TAMM IN THE TAMM AREA 09990020 * (PRESENTLY USED AS THE TAMM FOR MAIN FREE AREA), AND THE ADDRESS 10080020 * OF THE LAST BYTE OF FREE AREA AVAILABLE FOR TAMER-ACCESS TABLES. 10170020 * 10260020 ALAST DC A(LASTAM) 10350020 DS 0F 10440020 * 10530020 * TEMPORARY CELLS FOR BASIC ASSEMBLER USAGE ONLY 10620020 * 10710020 DLDHSH DC A(DHASH) DE110 10800020 DLDINC DC A(DINCOR) 10890020 DLGCOD DC A(DGRPCD) DE110 10980020 DLHSCD DC A(DHSHCD) 11070020 LDLDIC DC A(DLDIC) 11160020 EJECT 11250020 DS 0F 11340020 * 11430020 * 11520020 EJECT 11610020 * ACCESS CONSTANT AND WORK AREAS REFER. BY REG13 11700020 * 11790020 * HOUSEKEEPING FOR THE DICTIONARY 11880020 * LASTAM IS THE TAMM FOR THE CURRENT FREE AREA 11970020 * 12060020 * 12150020 * HOUSEKEEPING FOR THE DICOT TABLE, NEEDED BY TAMER 12240020 * THE DICOT TABLE IS THE TABLE USED TO HOLD INFORMATION ON THE 12330020 * DICTIONARY SEGMENTS. IT CONTAINS AN ENTRY FOR EACH SECTION AND 12420020 * ITS ORDER CORRESPONDS TO THE ORDER OF THE SECTIONS. 12510020 * EACH ENTRY IS 12 BYTES LONG--- 12600020 * BYTE 0 = CODE TESTED FOR STATUS OF SECTION. 12690020 * BYTES 1-3 = ADDRESS OF A DICT. SECTION IN CORE. 12780020 * BYTES 4-11= ADDRESS, ON DISK, OF A SPILLED SECTION. 12870020 * 12960020 * THE CORE ADDRESS OF A SPILLED SECTION IS OBSOLETE UNTIL THE 13050020 * SECTION IS READ BACK IN FOR UPDATING. THEN BOTH ADDRESSES, DISK 13140020 * AND CORE, ARE TRUE. AFTER SPILL, UNTIL UPDATE, THE TRUE 13230020 * ADDRESS IS THAT IN BYTES 4-11 OF THE DICOT ENTRY FOR THE SECT. 13320020 * 13410020 * 13500020 * TIB20 RESERVED FOR THE DICOT TABLE IN PHASES 1,2,3 13590020 * 13680020 * PARAMETER LOCATION NEEDED FOR CALL TO PRIME 13770020 * 13860020 DS 0F 13950020 DLDIC DC X'0C' ENTRY SIZE IS 12 BYTES. 14040020 DC X'0000AC' 14130020 DC H'240' PRIME SIZE OS 14220020 DC H'120' GROW REQUEST AMOUNT. 14310020 SPACE 5 14400020 * STORE UNDER DATA FOR DINCOR. 14490020 DS 0F 14580020 DUPDCD DC X'FF000000' 14670020 DCENLG DC F'12' LENGTH OF DICOT TABLE ENTRY. 14760020 DINSTR DC 5F'0' 14850020 DINSTB DC 2F'0' 14940020 EJECT 15030020 * LOCATIONS FOR BOTH 'ENT' AND 'L' SERIES 15120020 * SHOULD NOT BE OVERLAID 15210020 * 15300020 * 15390020 * 15480020 * REGISTER SAVE AREA 15570020 * 15660020 * 'ENT','L' SERIES, 'ENTDEL','LOCNXT' USE SAME AREA SINCE ONLY 15750020 * ONE OF THESE ROUTINES IS CALLED AT A TIME 15840020 * 'DHASH', 'DINCOR' HAVE THEIR OWN AREA SEPARATE SINCE THEY ARE 15930020 * CALLED BY THE OTHER ROUTINES 16020020 * 16110020 * 'DHASH' STORAGE AREA 16200020 DS 0F 16290020 DSTORE DS CL4 16380020 DSTOR1 DS CL4 16470020 D33S14 DC 2F'0' SAVE AREA FOR R14,R15,UPON DEMORE CALL TO DICSP 16560020 * 16650020 DRSAVE DS CL56 SAVE AREA FOR 'ENT' SERIES, REG. 2-15 16740020 DL4 EQU DRSAVE SAVE AREA FOR 'L' SERIES 16830020 * 16920020 * 17010020 * SAVE AREAS FOR REG 14,15 ARE UNDER REG12 17100020 * 17190020 * FOR 'DL' SERIES 17280020 D1SV14 DS F 17370020 DL15 DS CL4 17460020 DS 2F ADDITIONAL STORAGE, USED IN INTACC 17550020 * 17640020 * FOR 'LOCNXT' 17730020 D2SV14 EQU D1SV14 17820020 D2SV15 EQU DL15 17910020 * 18000020 * FOR 'DE' SERIES 18090020 D3SV14 EQU D1SV14 18180020 DS15 EQU D2SV15 18270020 * 18360020 * FOR 'ENTDEL' 18450020 D4SV14 EQU D1SV14 18540020 D4SV15 EQU D2SV15 18630020 * 18720020 * FOR 'INTACC' 18810020 D5SV14 EQU D1SV14 18900020 D5SV15 EQU D2SV15 18990020 * 19080020 * 19170020 * CONSTANTS, MASKS, WORK AREAS 19260020 * COMMON TO BOTH PARTS OF ACCESS 19350020 * 19440020 * CONSTANTS 19530020 DS 0F 19620020 DHDIV DC F'521' DIVIDE CONSTANT FOR DHASH 19710020 DMDSPL DC X'000001FF' MASKS OUT ALL BUT DISPLAC 19800020 DMSECT DC X'003FFE00' MASKS OUT ALL BUT SECT. NO. 19890020 D512 DC F'512' 19980020 DSUBVL DC X'00000200' USED IN DINCOR TO DECREM. SECT. NO. 20070020 * 20160020 * WORK CELL 20250020 DS 0F 20340020 DWORK DS CL1 DUMMY FOR REG REFER 20430020 DWORK1 DS CL3 20520020 DELSAV DC F'0' FOR DELIM PTR IN CASE SPILLED SECTION 20610020 * 20700020 DS 0F 20790020 * DHWORD BYTE =0 USED BY DE210 20880020 DHWORD DC X'00' DUMMY FOR XR PICK-UP, MUST BE ZERO (LTR) 20970020 DHSHCD DS CL3 DUP. HASH CODE 21060020 * DGRPCD MUST START ON A FULL WORD BOUNDARY AND MUST FOLLOW DHSHCD. 21150020 * WHEN DUP. HASH AND GROUP CODES APPEAR TOGETHER, THEY ARE MOVED INT 21240020 * THE DICT. AS ONE UNIT (SEE DMVCOD). 21330020 DGRPCD DC X'400000' GROUP CODE, 01 IN 1ST 2 BITS 21420020 EJECT 21510020 * HOUSEKEEPING FOR ACESS ROUTINES LATRNM,LATRPT,LDELNM,LATACP,LATGRP 21600020 * 21690020 * LOCATIONS FOR 'L' SERIES 21780020 * SHOULD NOT BE OVERLAID 21870020 DS 0F 21960020 DSWTCH DC A(DL500) FOR LATACP SWITCH OFF 22050020 * 22140020 * MASKS DM PREFIX 22230020 DS 0F 22320020 * DMSKCD BYTE0 USED TO SET DLMPTR BYTE0 NON-ZERO 22410020 DMSKCD DC X'003FFFFF' MASK OUT CODE BITS 22500020 DMSKDL DC X'FF000000' BYTE 0 MUST BE NON-ZERO 22590020 DMBYT1 DC X'00FFFFFF' MASKS OUT 1ST BYTE (AND) 22680020 * 22770020 * NAME COMPARISON INSTRUCTION 22860020 DCOMPR CLC 0(0,R2),0(R9) R2=A(DICT NAME), R9=A(INPUT NAME) 22950020 * 23040020 * LAST VALID ENTRY POINTER (NEEDED FOR LATACP) 23130020 * BITS 0-7 MUST EQUAL ZERO 23220020 DS 0F 23310020 DSTART DC F'0' MUST BE SET TO 0.NOT USED ACROSS PH5. 23400020 * 23490020 * 'DLMPTR' SET IN ALL VALID CALLS TO ACCESS BY 'L' ROUTINES, 23580020 * TESTED BY LATACP. VALUE = GROUP DELIMITER POINTER FOR GROUP ITEMS 23670020 * FOUND BY LATACP, LDELMN, ITS BYTE0 NONZERO FOR ELEM. ITEMS FOUND 23760020 * BY LATACP, SET ZERO BY ALL OTHER ROUTINES. 23850020 * 23940020 * 'DLTEMP' USED IN 'L' SERIES TO SAVE A(ATTRIB) OF FIRST MATCH 24030020 * FOUND CHANGE THIS IF 'DLMPTR' USED IN DL300 LOOP 24120020 DLMPTR DC F'0' SET TO 0 BY DEFINITION. 2/16/66. 24210020 DLTEMP EQU DLMPTR 24300020 EJECT 24390020 * HOUSEKEEPING FOR ENTNAM,ENTPTR,GETPTR 24480020 * OVERLAID IN PHASE 3 24570020 * 24660020 * 24750020 * MASKS FOR 'ENT' SERIES 24840020 DS 0F 24930020 DMPFX2 DC X'00800000' INSERTS PREFIX=2 IN 2ND BYTE 25020020 DMPFX3 DC X'00C00000' INSERTS PREFIX=3 IN 2ND BYTE 25110020 DMDLM DC X'C00000' MASK TO CLEAR DELIM PART OF GROUP CODE 25200020 * 25290020 * MOVE INSTRUCTIONS R2=DICT ADDRESS 25380020 DS 0F 25470020 DMVCOD MVC 0(0,R2),0(R8) R8= 0GRPCD,DHSHCD 25560020 DMOVE MVC 0(0,R2),0(R9) R9= A(NAME,ATTRIB) 25650020 EJECT 25740020 DTSAVE DC F'0' 25830020 EJECT 25920020 SPACE 5 26010020 ****** ****** 26100020 ****** ****** 26190020 * * 26280020 * ** INTACC ** * 26370020 * * 26460020 * INTACC---ACCESS INITIALIZATION ROUTINE. * 26550020 * * 26640020 * CALLS----INTACC IS CALLED AS PART OF INITIALIZATION BY * 26730020 * EACH PHASE USING ACCESS. * 26820020 * * 26910020 * FUNCTION-INTACC PRIMES THE DICOT TABLE AND MOVES ADDRESS * 27000020 * OF TAMER ROUTINES CALLED BY ACCESS FROM COMMON TO 27090020 * ITS OWN ADDRESS STORAGE AREA. 27180020 * 27270020 ***** 27360020 DS 0F 27450020 USING *,R15 27540020 INTACC EQU * 27630020 ST R12,DINS12 27720020 L R12,DATADD STORE R12. 27810020 STM R14,R1,D5SV14 STORE REST UNDER BASE 12 27900020 ****** THE LOADING OF THE FOLLOWING PARAMETERS MUST BE DONE 27990020 ****** BEFORE ANY ACCESS ROUTINE OTHER THAN INTACC IS CALLED. 28080020 L R1,DPARST LOAD A(COS). 28170020 MVC LPRIME(8),APRIME 28260020 * PARAMETER LIST 28350020 MVC DTAMM1(4),ALSTAM 28440020 MVC DMVDAD(4),AMOVDC 28530020 TM ACCESW,1 28620020 BC ONES,INTCEX NO. DICOT TABE PRIMED. EXIT 28710020 MVI ACCESW,1 28800020 * ON FIRST CALL TO INTACC, THE HASH TABLE IS ZEROED OUT, AND THE 28890020 * DICOT TABLE IS PRIMED. HASH TABLE=(521) (3)=(1563) BYTES LONG. 28980020 L R1,ACCESW A(HASA TABLE) 29070020 LA R14,6 LOAD LOOP COUNT. 29160020 PHTBZR XC 0(255,R1),0(R1) CLEAR 255 BYTES. 29250020 LA R1,255(R1) INCREMENT. 29340020 BCT R14,PHTBZR 29430020 XC 0(33,R1),0(R1) CLEAR TABLE. 29520020 * AFTER ZERO-OUT OF HASH TABLE, PRIME DICOT TABLE. 29610020 L R1,LDLDIC LOAD A(DICOT TABLE PARM). 29700020 L R15,LPRIME A(PRIME). 29790020 BALR R14,R15 CALL PRIME 29880020 * EXIT AFTER INITIALIZATION FINISHED. 29970020 INTCEX LM R14,R1,D5SV14 30060020 L R12,DINS12 30150020 BCR 15,R14 RETURN. 30240020 ****** THIS AREA IS FOR STORAGE OF R12 UNDER R15, 30330020 ****** AND DATA BASE ADDRESS. 30420020 DATADD DC A(PBEG12) DATA BASE ADDRESS 30510020 DINS12 DC F'0' STORAGE FOR CALLER'S REG 12. 30600020 EJECT 30690020 * * 30780020 * ** DINCOR ** * 30870020 * * 30960020 * DINCOR--- GIVEN A DICTIONARY POINTER, DINCOR CHECKS TO SEE * 31050020 * IF THE SECTION FOR THAT POINTER IS IN CORE. * 31140020 * IF IT IS- DINCOR RETURNS WITH THE ENTRY ADDRESS. * 31230020 * IF NOT--- DINCOR CALLS THE ROUTINE WHICH READS * 31320020 * IN THE SPILLED SECTION,THE RETURNS WITH * 31410020 * THE ENTRY ADDRESS. * 31500020 * INPUT---- R2 = DICTIONARY POINTER * 31590020 * OUTPUT--- R2 = ENTRY ADDRESS . * 31680020 * R0 = SEGMENT ADDRESS,USED IN LOCNXT. * 31770020 * * 31860020 ****** ****** 31950020 SPACE 5 32040020 DS 0F 32130020 USING *,R15 32220020 DINCOR EQU * 32310020 STM R3,R7,DINSTR STORE REGISTERS. 32400020 STM R14,R15,DINSTB STORE DINCOR BASE ADDRESS,RETURN AD. 32490020 LR R5,R2 LOAD DICT.POINTER 32580020 N R5,DMSECT MASK OUT SECT. NUMBER. 32670020 S R5,DSUBVL SUB X'200' FOR DICOT SECT.NUMBER-- 32760020 * GIVING 1 SECTION LOWER THAN SECTION 32850020 * VALUE IN POINTER. 32940020 SRL R5,9 SHIFT DOWN TO OBTAIN SECTION NUMBER. 33030020 * 0 FOR SECTION 1, 33120020 * 1 FOR SECTION 2, 33210020 * 2 FOR SECTION 3, ETC. 33300020 M R4,DCENLG MULTIPLY BY LGTH OF DICOT ENTRY. 33390020 * RESULT,IN R5, IS DISPLACEMENT. 33480020 L R7,DPARST LOAD A(COS). 33570020 LA R7,LDICOT(R7) OBTAIN A(TIB20)= A(DICOT TIB). 33660020 L R7,0(R7) LOAD A(DICOT TAMM). 33750020 L R7,0(R7) LOAD A(DICOT TABLE). 33840020 LA R3,0(R5,R7) LOAD A(ENTRY FOR POINTER). 33930020 SPACE 2 34020020 * TEST HERE FOR SECTION IN CORE, OR SPILLED SECTION. 34110020 TM 0(R3),128 HAS SECTION BEEN SPILLED? 34200020 BC ZERO,DINSCA NO. LOAD ADDRESS OF SECTION. 34290020 TM 0(R3),96 YES.HAS IT BEEN READ IN,UPDATED? 34380020 BC ONES,DINSCA YES.THEN CORE ADDRESS IS VALID 34470020 SPACE 2 34560020 * THIS CODE CALLS TAMER'S MOVDIC ROUTINE, WHICH READS IN SPILLED 34650020 * SECTION,AND ADJUSTS THE DICOT ENTRY FOR IT ACCORDINGLY. 34740020 * MOVDIC RETURNS THE SECTION ADDRESS IN R0. 34830020 SPACE 2 34920020 DGTSPL L R15,DMVDAD NO. LOAD A(MOVDIC). 35010020 O R15,DUPDCD SET HIGH BYTE OF 15 =X'FF' 35100020 BALR R14,R15 CALL MOVDIC. 35190020 * WHEN DINCOR CALLS MOVDIC, IT PASSES A(DICOT ENTRY)FOR SECTION 35280020 * IN R3. MOVDIC PLACES IN-CORE ADDR. OF SECT. IN DICOT TABLE. 35370020 LM R14,R15,DINSTB RESTORE A(DINCOR),RETURN ADDRESS. 35460020 DINSCA L R0,0(R3) NO. LOAD ADDRESS OF SECTION. 35550020 N R0,DMBYT1 MASK OUT TOP BYTE IN ADDRESS REG. 35640020 N R2,DMDSPL MASK OUT ALL BUT DISPLACEMENT. 35730020 AR R2,R0 OBTAIN ADDRESS OF ENTRY. 35820020 SPACE 2 35910020 DINCEX LM R3,R7,DINSTR RELOAD REGISTERS USED. 36000020 BCR 15,R14 RETURN TO CALL 36090020 EJECT 36180020 EJECT 36270020 * ROUTINE 'DHASH' 36360020 * USED BY BOTH 'ENT','L' SERIES 36450020 * 36540020 * HASHES BCD NAME, LOCATES CORRES. HASH TABLE ENTRY 36630020 * INPUT R9=A(BCD NAME) 'ENT' R9 'L' R9 36720020 * R11= BCD NAME CNT R11 R11 36810020 * OUTPUT R8= 0,DICT PNTR R8 R8 36900020 * R10= A(HASH TABLE ENTRY) R10 R10 36990020 * R8/R9 EVEN/ODD DIVIDEND 37080020 * R10/R11 EVEN/ODD INCREM./COMPAR. 37170020 * 37260020 * HASHING FUNCTION 37350020 * SEGMENT NAME (INCL. CNT) INTO 4 BYTE LENGTHS, ADD LENGTHS 37440020 * TOGETHER LOGICALLY, DIVIDE SUM BY SIZE OF HASH TABLE, MULT 37530020 * REMAIN. BY 3 TO OBTAIN DISPL. ADD IT TO A(HASH TABLE) AND 37620020 * PICK UP CORRES. ENTRY 37710020 * ENTRY=0 OR DICT. PNTR OF LAST BCD NAME WHICH HASHED TO THIS LOC 37800020 * 37890020 * NOTE THAT INPUT NAME IS PADDED OUT WITH ZEROES SO 4 BYTES CAN BE 37980020 * ADDED AT A TIME 38070020 * 38160020 * 38250020 DS 0F 38340020 USING *,R15 38430020 DHASH EQU * 38520020 ST R9,DSTORE 38610020 LA R10,4(R0,R0) R10=INCREMENT=4 38700020 SR R8,R8 R8= CNTR =0,4,... 38790020 SR R0,R0 R0=SUM, INITIALLY ZERO 38880020 DHLOOP AL R0,0(R9,R8) NOTE, NO OVERFLOW INTERRUPT 38970020 BXLE R8,R10,DHLOOP R8= R10+1 =COMPARAND 39060020 LR R9,R0 39150020 SR R8,R8 R9= R8+1 39240020 D R8,DHDIV R8/R9 =DIVIDEND, SIGN IS + 39330020 LA R10,0(R8,R8) R8= REMAINDER, MULT BY 3 39420020 AR R10,R8 39510020 * DISPLAC COMPUTED, OBTAIN ENTRY 39600020 * 39690020 * TEMPORARY HASH TABLE PLACEMENT OF HASH TABLE,'PHASHT', AT END 39780020 * OF TAMER CODING IN PHASE 0. 39870020 * 39960020 L R8,DPARST LOAD ADDRESS OF COS. 40050020 L R8,ACCESW-COS(R8) A(PHASHT) 40140020 LA R10,0(R10,R8) INCREMENT TO DISPLACEMENT IN HASH 40230020 * TABLE FOR CURRENT DICTIONARY ENTRY. 40320020 MVC DHSHCD(3),0(R10) 40410020 L R8,DHWORD 1ST BYTE MUST = 0 40500020 L R9,DSTORE 40590020 BCR UNCOND,R14 40680020 * 40770020 * 40860020 EJECT 40950020 * ACCESS ROUTINES LATRNM,LATRPT,LDELNM,LATACP,LATGRP 41040020 * 'L' (LOCATE) SERIES 'DL' PREFIX 41130020 * NOTE SHOULD NEVER USE LATACP FOLLOWING AN INVALID CALL TO ACCESS. 41220020 * LATACP TESTS 'DLMPTR', SET IN LAST VALID CALL TO ACCESS. 41310020 * 'DLMPTR' = GROUP DELIMITER POINTER IF LAST CALL WAS TO LATACP, 41400020 * LDELMN AND ENTRY WAS VALID AND GROUP ITEM. 'DLMPTR' BYTE0 NONZERO 41490020 * IF LAST CALL WAS BY LATACP AND ELEM. ITEM WAS FOUND. 'DLMPTR' 41580020 * SET ZERO BY ALL OTHER ROUTINES. 41670020 * 41760020 * 41850020 DS 0F 41940020 DLBEG EQU * 42030020 LATRNM EQU * 42120020 LATRPT EQU * 42210020 LDELNM EQU * 42300020 LATACP EQU * 42390020 LATGRP EQU * 42480020 * 42570020 USING *,R15 42660020 ST R12,D1SV12 REG12 IS USED TO REFER. CONSTANTSETC 42750020 L R12,D1RG12 42840020 STM R14,R15,D1SV14 REG13 IS NOT USED SO NOT SAVED 42930020 TM 0(R1),DMACP 43020020 BC ZERO,DL200 43110020 * 43200020 * LATACP, LATGRP ENTRY COMPUTE LIMITS FOR ENTRY TO BE LOCATED 43290020 * DSTART WILL = LOWER LIMIT OF ENTRIES TO SCAN, IE. = HEADER GROUP 43380020 * POINTER. R5 WILL = UPPER LIMIT OF ENTRIES TO SCAN, IE.= DELIMITER 43470020 * PONTER. IN LATGRP, PICK UP DELIMITER POINTER FROM GROUP HEADER 43560020 * DICT. ENTRY. IN LATACP, TEST 'DLMPTR' (SEE COMMENTS). 43650020 DL100 STM R4,R11,DL4 43740020 SR R6,R6 SET LATACP SWITCH ON 43830020 TM 0(R1),DMATRP 43920020 BC NOTZER,DL150 44010020 * 44100020 * LATACP ENTRY, CHECK 'DLMPTR' 44190020 * 'DLMPTR' = GROUP DELIMITER POINTER IF LAST CALL TO ACCESS WAS BY 44280020 * LDELMN OR LATACP AND ENTRY WAS VALID AND GROUP ITEM. 44370020 * 44460020 DL110 L R2,DSTART DSTART= LAST VALID ENTRY POINTER 44550020 L R5,DLMPTR 44640020 LTR R5,R5 44730020 BC ZERO,DL160 44820020 TM DLMPTR,DMBYT IF BYTE0 IS NONZERO, LAST ITEM WAS ELEM. 44910020 BC ZERO,DL160 45000020 * 45090020 * LAST CALL WAS FOR ELEM. ITEM, INPUT ITEM ELEM. ITEM ERROR EXIT 45180020 DL130 LA R14,12(R0) 45270020 BC UNCOND,DXEXIT 45360020 * 45450020 * LATGRP ENTRY, LATACP ENTRY WHEN LAST CALL WAS NOT BY LATACP, 45540020 * LDELMN. REFERENCE GROUP HEADER DICT. ENTRY TO OBTAIN DELIMITER 45630020 * POINTER 45720020 * NOTE THAT 'DSTART' BYTE0 MUST =0 OK SINCE LATGRP INPUT CODE =0. 45810020 DL150 L R2,4(R1) LATGRP 45900020 ST R2,DSTART 45990020 * 46080020 * NOW OBTAIN DELIM.,IF ANY, FOR GROUP ITEM SET R5=DELIM 46170020 DL160 L R15,DLDINC R2= INPUT 46260020 BALR R14,R15 46350020 L R15,DL15 OUTPUT R2=DICT ADDRESS 46440020 TM 0(R2),DMPFT1 46530020 BC ZERO,DL170 46620020 LA R2,3(R2) UPDATE PAST HASH CODE 46710020 DL170 TM 0(R2),DMPFT2 46800020 BC ZERO,DL130 BRANCH IF NO GROUP CODE 46890020 MVC DWORK1(3),0(R2) 46980020 L R5,DWORK SET R5=GROUP DELIM POINTER 47070020 N R5,DMSKCD MASK OUT CODE BITS 47160020 BC UNCOND,DL210 47250020 * 47340020 * INITIAL. LATRNM,LATRPT,LDELNM TEST IF LATRPT 47430020 DL200 TM 0(R1),DMATRP SUFFIC TEST CANNOT BE LATGRP 47520020 BC ONES,DL700 47610020 STM R4,R11,DL4 47700020 L R6,DSWTCH SET LATACP SWITCH OFF 47790020 * 47880020 * PROCESSING FOR ALL ROUTINES EXCEPT LATRPT 47970020 * HASH THE INPUT NAME, INVESTIGATE DICT. ENTRIES THAT HASH TO SAME 48060020 * VALUE. INITIALLY AGREE CODE =0. WHEN 1ST MATCH IS FOUND, SET 48150020 * AGREE CODE = ITS POINTER. 48240020 DL210 SR R3,R3 SET AGREE CODE=0 48330020 L R9,0(R1) SET R9= A(INPUT BCD NAME) 48420020 SR R11,R11 48510020 IC R11,0(R9) SET R11=INPUT NAME CNT 48600020 L R15,DLDHSH 48690020 BALR R14,R15 48780020 L R15,DL15 48870020 LTR R8,R8 DHASH OUTPUT R8= 0,DICT POINTER 48960020 BC NOTZER,DL300 49050020 LA R14,4(R0,R0) NO POINTER PRESENT ERROR EXIT 49140020 BC UNCOND,DXEXIT 49230020 * 49320020 * LOOP CHECK THRO ALL DUP. HASH NAMES UNTIL NO MORE FOUND OR 2 49410020 * MATCHES FOUND 49500020 * R8= CURRENT TEST POINTER LOOP DL300-DL550 49590020 * INITIAL VALUE OF CURRENT POINTER = C(HASH TABLE ENTRY). 49680020 * 49770020 * LATACP ENTRY TEST IF CURRENT POINTER POINTS TO ENTRY BETWEEN 49860020 * GROUP HEADER AND DELIMITER 49950020 * IF NOT, CHECK NEXT DUP HASH POINTER IF ANY 50040020 * TEST IF LATACP, LATGRP ENTRY (R6=0) 50130020 * IF YES, TEST IF CURRENT POINTER LESS THAN GROUP HEADER POINTER 50220020 DL300 LTR R6,R6 50310020 BC NOTZER,DL310 50400020 C R8,DSTART 50490020 BC LO,DL560 CURRENT POINTER LESS, DISCONTINUE SEARCH 50580020 DL310 LR R2,R8 50670020 L R15,DLDINC 50760020 BALR R14,R15 LOCATE ENTRY 50850020 L R15,DL15 OUTPUT R2=DICT ADDRESS 50940020 SR R7,R7 R7= DUP HASH INDICATOR 51030020 TM 0(R2),DMPFT1 51120020 BC ZERO,DL400 51210020 MVC DWORK1(3),0(R2) SET R7=DUP HASH POINTER 51300020 L R7,DWORK 51390020 N R7,DMSKCD MASK OUT CODE BITS 51480020 LA R2,3(R2,R0) 51570020 * 51660020 * AGAIN, TEST IF LATACP, LATGRP ENTRY (R6=0) 51750020 * NOTE 1ST TEST (DL300) WAS TO AVOID POSSIBLE UNNECESSARY 51840020 * RETRIEVAL OF A SEGMENT 51930020 * IF YES, CHECK FOR MATCH ONLY IF CURRENT POINTER LESS THAN 52020020 * DELIMITER POINTER 52110020 DL400 LTR R6,R6 52200020 BCR NOTZER,R6 IF NOT, R6=DL500 52290020 * 52380020 CR R8,R5 R5=DELIMITER 52470020 BC NOTLO,DL550 52560020 * 52650020 * DOES DICT. NAME AGREE WITH INPUT NAME 52740020 * NOTE DL500 IS THE TRANSFER POINT IN LATACP SWITCH 52830020 DL500 SR R10,R10 R10 INDICATOR FOR LDELNM 52920020 TM 0(R2),DMPFT2 53010020 BC ZERO,DL510 53100020 LR R10,R2 SET R10=A(GROUP CODE) 53190020 LA R2,3(R2) 53280020 * NOTE R11= CORRECT VALUE, 1 LESS THAN NO. OF BYTES TO BE COMPARED 53370020 DL510 EX R11,DCOMPR COMPARE NAMES, R11=INPUT NAME CNT 53460020 BC NOTEQ,DL550 53550020 LTR R3,R3 TEST AGREE CODE 53640020 BC ZERO,DL520 53730020 * 53820020 * NAMES AGREE, NOT FIRST MATCH, ERROR EXIT 53910020 LA R14,8(R0) 54000020 BC UNCOND,DXEXIT 54090020 * 54180020 * 54270020 * NAMES AGREE, FIRST MATCH 54360020 * SET R3= ITS DICT POINTER 54450020 * SET R4 =A(GROUP CODE OF 1ST MATCH) 54540020 DL520 LR R3,R8 54630020 LR R4,R10 54720020 MVC DELSAV(3),0(R10) 54810020 * 54900020 * DOES THIS ENTRY POINT TO ANOTHER DUP HASH VALUE 54990020 DL550 LTR R7,R7 55080020 BC ZERO,DL560 55170020 LR R8,R7 YES, SET CURRENT PNTR= DUP HASH POINTER 55260020 BC UNCOND,DL300 55350020 * 55440020 * NO MORE DUP HASH, CHECK IF MATCH WAS EVER FOUND 55530020 DL560 LTR R3,R3 55620020 BC NOTZER,DLEXIT 55710020 LA R14,4(R0) NO, ERROR EXIT 55800020 BC UNCOND,DXEXIT 55890020 * 55980020 * VALID ENTRY EXIT OUTPUT IN REG 2,3,15 REG4 RESTORED 56070020 * TEST IF LDELMN, LATACP ENTRY 56160020 * IF YES, TEST IF ENTRY IS GROUP ITEM 56250020 * R4 = A(GROUP CODE, IF ANY, OF MATCH) 56340020 DL600 EQU * 56430020 DLEXIT LR R2,R3 56520020 L R15,DLDINC 56610020 BALR R14,R15 56700020 L R15,DL15 56790020 TM 0(R2),DMPFXT 56880020 BC ZERO,DL602 56970020 LA R2,3(R2) 57060020 BC MIXED,DL602 57150020 LA R2,3(R2) 57240020 DL602 EQU * 57330020 LA R2,1(R2,R11) 57420020 TM 0(R1),DMDELM 57510020 BC ZERO,DL610 57600020 LTR R4,R4 LDELMN ENTRY 57690020 BC NOTZER,DL620 57780020 * 57870020 * LDELNM INPUT NAME ELEM ITEM, ERROR EXIT REG2,3 SET UP, REG4 UNCHG 57960020 LA R14,12(R0) 58050020 BC UNCOND,DXEXIT RESTORE REG4 58140020 * 58230020 * NOT LDELMN, TEST IF LATACP 58320020 DL610 TM 0(R1),DMACPP NOTE CANNOT BE LATRPT SO TEST IS OK 58410020 BC NOTMXD,DL640 58500020 * LATACP, IF NOT GROUP ITEM, SET 'DLMPTR' BYTE0 NONZERO 58590020 LTR R4,R4 58680020 BC NOTZER,DL620 58770020 L R4,DMSKDL (DMSKDL) BYTE 0 = FF 58860020 BC UNCOND,DL650 58950020 * 59040020 * LATACP, LDELMN ENTRY AND A GROUP ITEM 59130020 * SET 'DLMPTR', REG1 = GROUP DELIMITER POINTER (BYTE0=0) 59220020 DL620 MVC DWORK1(3),DELSAV 59310020 L R1,DWORK 59400020 N R1,DMSKCD MASK OUT CODE 59490020 ST R1,DLMPTR 59580020 BC UNCOND,DL660 59670020 * 59760020 DL640 LR R4,R4 NOT LATACP, LDELMN 59850020 DL650 ST R4,DLMPTR SET UP 'DLMPTR' 59940020 * BYTE0=0 AS REQUIRED FOR DSTART 60030020 DL660 ST R3,DSTART SET DSTART=VALID ENTRY DICT. POINTER 60120020 LM R4,R11,DL4 60210020 L R14,D1SV14 MUST PRECECE LOAD OF REG12 60300020 L R12,D1SV12 REG15 VALUE OKAY 60390020 SR R15,R15 NOW SET REG15 =RETURN VALUE 60480020 BCR UNCOND,R14 60570020 * 60660020 * ERROR EXIT SET UP REG15 60750020 DXEXIT ST R14,D1SVEM SAVE ERROR CODE, CANNOT SET REG15 YET 60840020 LM R4,R11,DL4 60930020 L R14,D1SV14 MUST PRECEDE LOAD OF REG12 61020020 L R12,D1SV12 REG15 VALUE OKAY 61110020 L R15,D1SVEM LOAD REG15 WITH ERROR CODE VALUE 61200020 BCR UNCOND,R14 61290020 * 61380020 * LATRPT ENTRY, SET REG2=A(ATTRIB) 61470020 * USES R2, R11 61560020 DL700 ST R11,DL4 61650020 L R2,0(R1) 61740020 N R2,DMBYT1 61830020 ST R2,DSTART SET DSTART= ENTRY POINTER 61920020 L R15,DLDINC 62010020 BALR R14,R15 62100020 L R15,DL15 LOCATE ENTRY, OUTPUT R2= DICT ADDRESS 62190020 TM 0(R2),DMPFXT 62280020 BC ZERO,DL720 62370020 LA R2,3(R2) 62460020 BC MIXED,DL720 62550020 LA R2,3(R2) 62640020 DL720 SR R11,R11 62730020 ST R11,DLMPTR SET DLMPTR =0 62820020 IC R11,0(R2) SET R11= NAME CNT 62910020 LA R2,1(R2,R11) 63000020 * DUMP OF REGISTERS ONLY CODE =2 63090020 L R11,DL4 63180020 L R14,D1SV14 MUST PRECEDE LOAD OF REG12 63270020 L R12,D1SV12 REG15 VALUE OKAY 63360020 BCR UNCOND,R14 63450020 * 63540020 * 63630020 D1RG12 DC A(PBEG12) 63720020 * D1SVEM UNDER REG15 USED TO HOLD ERROR CODES REG15 IS BOTH 63810020 * BASE REG. AND ERROR CODE REG. CANNOT LOAD IT UNTIL EXIT 63900020 D1SVEM DS F 63990020 D1SV12 DS F 64080020 EJECT 64170020 AIF ('&PHASE' EQ '3').PH3 64260020 * ACCESS ROUTINES ENTNAM,ENTPTR,GETPTR R2 PREFIX 64350020 * 64440020 * 64530020 DS 0F 64620020 USING *,R15 64710020 DEBEG EQU * 64800020 ENTNAM EQU DEBEG 64890020 ENTPTR EQU DEBEG 64980020 GETPTR EQU DEBEG 65070020 * REG. 0,1 WILL NOT BE SAVED 65160020 * MODIFY LATER REG. 2,12 DO NOT HAVE TO BE SAVED 65250020 * 65340020 ST R12,D3SV12 65430020 L R12,D3RG12 65520020 STM R14,R15,D3SV14 65610020 STM R2,R11,DRSAVE 65700020 SR R11,R11 65790020 SR R7,R7 65880020 TM 0(R1),DMEPTR 65970020 BC ONES,DE500 BRANCH IF ENTPTR ENTRY 66060020 * 66150020 * SET UP GROUP CODE, HASH CODE 66240020 DE100 L R9,0(R1) R9=A(BCD NAME) SET UP FOR DHASH 66330020 IC R11,0(R9) R11=NAME CNT 66420020 L R15,DLDHSH *HASH NAME 66510020 BALR R14,R15 66600020 L R15,DS15 OUTPUT R8= (0, DUP. POINTER) 66690020 LR R3,R8 66780020 SR R4,R4 66870020 TM 0(R1),DMGRUP 66960020 BC ZERO,DE110 67050020 L R8,DLGCOD *GROUP ITEM 67140020 LA R4,3(R0,R0) SET CNT=3 67230020 DE110 LTR R3,R3 TEST IF DUP HASH POINTER 67320020 BC ZERO,DE200 67410020 L R8,DLHSCD *LOAD ADDR OF HASH CODE 67500020 LA R7,3(R0,R0) SET CNT=3 67590020 O R3,DMPFX2 INSERT PREFIX 2 67680020 LTR R4,R4 67770020 BC ZERO,DE120 67860020 O R3,DMPFX3 GROUP CODE, INSERT PREFIX 3 67950020 DE120 ST R3,DHWORD 68040020 * 68130020 * COMPUTE TOTAL ENTRY SIZE, TEST IF SUFFIC. SPACE IN CURRENT SECTION 68220020 DE200 AR R4,R7 R4= CODE CNT 68310020 IC R7,4(R1) SET R7= ATTRIB CNT 68400020 LA R6,1(R11,R7) 68490020 AR R6,R4 R6= ENTRY SIZE 68580020 L R2,DPARST LOAD A(COS) 68670020 L R2,DICADR-COS(R2) 68760020 ***** 68850020 ST R4,DSTOR1 2/18/66 68940020 L R4,DPARST 69030020 L R3,ACCESW-COS(R4) HOLD DISP 69120020 LA R3,0(R3) INTO HASH TABLE 69210020 SR R10,R3 IN REG. 10 69300020 ***** 69390020 ***** 69480020 LR R3,R2 69570020 AR R3,R6 69660020 SR R5,R5 R5=0 THROUGHOUT PROGRAM 69750020 C R3,DLSVAL-COS(R4) 69840020 BC LO,DE205 69930020 BC HI,DEMORG RESTORE R4 BEFORE GO TO DEMORE 70020020 *DEL 70110020 DEMORG L R4,DSTOR1 2/18/66 70200020 BC 15,DEMORE GO TO DEMORE. 70290020 * WHEN ENTRY DOES NOT FILL SEGMENT, STORE ZERO IN 1ST BYTE AFTER 70380020 * ENTRY. IF THIS TURNS OUT TO BE LAST ENTRY IN SEGMENT, BYTE=O 70470020 * IN NEXT BYTE INDICATES THIS TO LOCNXT. 70560020 DE205 STC R5,0(R3) 70650020 DE210 L R4,DPARST 70740020 ST R3,DICADR-COS(R4) 70830020 L R3,ACCESW-COS(R4) GET ADDRESS OF ENTRY 70920020 LA R3,0(R3) IN THE HASH TABLE 71010020 AR R10,R3 INTO REG. 10 71100020 * UPDATED DICADR AT RETURN FROM DEMORE 71190020 * STORE HASH TABLE POINTER,CODE,IF ANY,IN DICT. 71280020 MVC 0(3,R10),DCPTR-COS(R4) 71370020 L R4,DSTOR1 2/18/66 71460020 * SET PREFIX =0. INDICATOR FOR ENTPTR IN CASE NO CODE IN ENTRY 71550020 * AND BCD NAME CAN BE STORED IMMEDIATELY. 71640020 STC R5,0(R2) 71730020 LTR R4,R4 71820020 BC ZERO,DE250 71910020 BCTR R4,R0 CODE, SUBT 1 72000020 EX R4,DMVCOD STORE CODE IN DICT 72090020 LA R2,1(R4,R2) UPDATE DICT REF 72180020 DE250 TM 0(R1),DMGPTR 72270020 BC ONES,DE400 BRANCH IF GETPTR ENTRY 72360020 * 72450020 * STORE ENTRY IN DICTIONARY 72540020 DE300 EX R11,DMOVE STORE NAME 72630020 LA R2,1(R2,R11) UPDATE DICT REFERENCE 72720020 BCTR R7,R0 SUBT 1 72810020 L R9,4(R1) R9=A(ATTRIB) 72900020 EX R7,DMOVE STORE ATTRIB 72990020 * 73080020 * ENTNAM, GETPTR UPDATE DICPTR 73170020 DE400 L R1,DPARST LOAD A(COS) 73260020 L R1,DICPTR OUTPUT FOR GETPTR 73350020 ***** 73440020 ***** 73530020 LR R4,R1 73620020 LR R11,R1 73710020 N R4,DMDSPL R4=DISPLAC. 73800020 AR R4,R6 73890020 N R4,DMDSPL MASK OUT POSSIBLE OFLO FOR 512 DISPL 1/66 73980020 N R11,DMSECT R11=SECT NO 74070020 ALR R4,R11 74160020 L R2,DPARST LOAD A(COS) 74250020 ST R4,DICPTR-COS(R2) 74340020 * REG 1 IS NOT SAVED, OUTPUT FOR GETPTR 74430020 DEXIT LM R2,R11,DRSAVE 74520020 * 74610020 L R14,D3SV14 MUST PRECEDE LOAD OF REG12 74700020 L R12,D3SV12 74790020 BCR UNCOND,R14 74880020 * 74970020 * 75060020 * ENTPTR ENTRY 75150020 DE500 L R2,8(R1) LOAD INPUT DICT POINTER 75240020 L R15,DLDINC MAKE SURE ENTRY IS IN CORE 75330020 BALR R14,R15 SETS R2= DICT. ADDR. 75420020 L R15,DS15 * 75510020 * TEST IF CODE FOR ENTRY IN DICT. 75600020 TM 0(R2),DMPFXT TEST ENTRY PREFIX 75690020 BC ZERO,DE520 ZERO IF NO CODE 75780020 BC MIXED,DE510 75870020 LA R2,3(R2) DOUBLE CODE, ADD 3 TO DICT REFER. 75960020 DE510 LA R2,3(R2) SINGLE CODE 76050020 DE520 IC R7,4(R1) ATTRIB. CNT 76140020 L R9,0(R1) A(BCD NAME) 76230020 IC R11,0(R9) NAME CNT 76320020 * STORE ENTRY IN DICT. 76410020 EX R11,DMOVE STORE NAME 76500020 LA R2,1(R2,R11) UPDATE DICT REF 76590020 BCTR R7,R0 76680020 L R9,4(R1) A(ATTRIB) 76770020 EX R7,DMOVE STORE ATTRIB 76860020 * REG 1 IS NOT RESTORED 76950020 LM R2,R11,DRSAVE 77040020 L R14,D3SV14 MUST PRECEDE LOAD OF REG12 77130020 L R12,D3SV12 77220020 BR R14 77310020 * 77400020 * 77490020 D3RG12 DC A(PBEG12) 77580020 D3SV12 DS F 77670020 * 77760020 EJECT 77850020 SPACE 5 77940020 ****** ****** 78030020 * * 78120020 * ** DEMORE ** * 78210020 * * 78300020 * * 78390020 * DEMORE--- AN INTERNAL ACCESS SUBROUTINE TO OBTAIN 512 * 78480020 * BYTES OF CORE FOR A DICTIONARY SECTION. * 78570020 * DEMORE CALLS DICSPC IN TAMER TO OBTAIN A * 78660020 * NEW SECTION. * 78750020 * * 78840020 * ENTRY REGISTERS--- R6 = ENTRY SIZE. * 78930020 * EXIT REGISTERS--- R2 = ADDRESS OF NEW SECTION. * 79020020 * R3 = UPDATED DICADR, * 79110020 * = A(NEW SECTION) + ENTRY SIZE. * 79200020 * * 79290020 * DEMORE--- UPDATES DICPTR,DLSVAL,AND DICOT TABLE. * 79380020 * --- ENTERS A(NEW SECTION) IN DICOT TABLE. * 79470020 * * 79560020 ****** ****** 79650020 SPACE 5 79740020 DS 0F 79830020 DEMORE EQU * 79920020 ST R1,DSTORE 80010020 ST R4,DSTOR1 STORE REGISTERS USED. 80100020 SPACE 2 80190020 * DEMORE CALLS DICSPC IN TAMER TO OBTAIN A NEW DICTIONARY SECTION. 80280020 STM R14,R15,D33S14 STORE 14,15. 80370020 LA R14,DEMRTA 80460020 L R15,DTAMM1 LOAD A(DICSPC),STORED BY INTACC. 80550020 BALR R14,R15 CALL DICSPC. 80640020 DEMRTA LM R14,R15,D33S14 80730020 SPACE 2 80820020 *** *** 80910020 * * 81000020 * REG1 =START ADDRESS OF NEW DICTIONARY SECTION. * 81090020 * REG2 =HIGH ADDRESS =(START+512) OF NEW DICTIONARY SECTION. * 81180020 * * 81270020 *** *** 81360020 SPACE 2 81450020 L R4,DPARST LOAD A(COS). 81540020 ST R2,DLSVAL-COS(R4) TOP ADDRESS OF SECTION 81630020 ST R1,DICADR-COS(R4) 81720020 SPACE 2 81810020 L R1,DPARST LOAD A(COS). 81900020 LA R1,LDICOT(R1) LOAD A(DICOT TIB)= A(TIB20). 81990020 L R15,LINSRT LOAD A(INSERT) 82080020 BALR R14,R15 CALL INSERT. 82170020 L R15,DS15 RESTORE BASE. 82260020 * INSERT OUTPUT--REG2 = A(INSERT ENT). 82350020 * REG3 = TABLE DISPL. 82440020 L R4,DPARST 82530020 L R4,DICADR-COS(R4) 82620020 ST R4,0(R2) STORE SECTION ADDRESS IN DICOT TABLE 82710020 NI 0(R2),0 CLEAR TOP BYTE OF DICOT ENTRY. 82800020 OI 0(R2),64 SET ON IN-CORE BIT. 82890020 LR R2,R4 LOAD SECT. ADD. INTO R2. 82980020 SPACE 2 83070020 ****** ACCESS TEMPORARY STORAGE OF NEW SECTION NUMBER IN DICPTR. 83160020 ****** SEE DE200. STORE NEWLY ASSIGNED SEC.NO. BEFORE RETURN TO DE210. 83250020 SPACE 2 83340020 ST R4,DTSAVE 83430020 L R4,DPARST LOAD A(COS). 83520020 L R3,DICPTR-COS(R4) 83610020 * 83700020 * NOTE- FIRST SECTION NUMBER ASSIGNED IS 1. 83790020 * DINCOR SUBTRACTS 1 TO OBTAIN CORRECT DICOT TABLE DISPL. 83880020 * 83970020 N R3,DMSECT MASK OUT ALL BUT SECT.NUMBER. 84060020 LA R3,512(R3) INCREMENT SECTION NUMBER. 84150020 ST R3,DICPTR-COS(R4) 84240020 ****** 84330020 ****** END OF DICPTR STORAGE CODING. NEW SECTION DISPLACEMENT IS ZERO. 84420020 SPACE 2 84510020 L R4,DTSAVE RESTORE R4. 84600020 LA R3,0(R2,R6) LOAD UPDATED DICT.ADDR. INTO R3. 84690020 * R2 = ADDRESS OF NEW SECTION. 84780020 * R6 = ENTRY SIZE,FROM DE200 SEQUENCE 84870020 L R4,DSTOR1 84960020 L R1,DSTORE 85050020 BC 15,DE210 RETURN TO DE210 WITH NEW DICADR. 85140020 SPACE 2 85230020 ** NOTE- DEMORE IS NOT CALLED BY A BALR 14,15 SEQUENCE. 85320020 ** IT IS CALLED BY A DIRECT BRANCH FROM DEMORG+4. 85410020 ** ITS BASE REGISTER IS THUS THE BASE OF THE CALLING 85500020 ** ROUTINE. ITS DATA BASE REGISTER IS THAT OF CALLING ROUTINE 85590020 ** DEMORE USES ONLY REGISTERS 2 AND 4 INTERNALLY. 85680020 ** IT SAVES AND RESTORES THESE. 85770020 EJECT 85860020 EJECT 85950020 * ACCESS ROUTINE 'ENTDEL' 86040020 * SEPARATE ENTRY POINT 86130020 * STORES DELIMITER IN DICT ENTRY FOR INPUT GROUP NAME 86220020 * INPUT REG1=A(INPUT DATA) 86310020 * 86400020 DS 0F 86490020 ENTDEL EQU * 86580020 USING *,R15 86670020 ST R12,D4SV12 86760020 L R12,D4RG12 REG12 IS USED TO REFER. CONSTANTS ETC 86850020 STM R14,R15,D4SV14 86940020 ST R2,DWORK 87030020 L R2,0(R1) 87120020 L R15,DLDINC 87210020 BALR R14,R15 87300020 L R15,D4SV15 87390020 TM 0(R2),DMPFT1 87480020 BC ZERO,DENT1 87570020 LA R2,3(R2) UPDATE PAST HASH CODE 87660020 * DEBUG CODING MAKE SURE GROUP CODE IS PRESENT 87750020 DENT1 EQU * 87840020 NC 0(3,R2),DMDLM ZERO OUT DELIM PART OF GRP CODE. 11/23 87930020 * THIS CLEARS DELIM PART IN CASE OF PREVIOUS DUMMY DELIM NTRY. 88020020 OC 0(3,R2),5(R1) INSERT DELIMITER INTO ENTRY 88110020 L R2,DWORK 88200020 L R14,D4SV14 PRECEDES LOAD OF REG13 88290020 L R12,D4SV12 88380020 BCR UNCOND,R14 88470020 * 88560020 D4RG12 DC A(PBEG12) 88650020 D4SV12 DS F 88740020 * 88830020 EJECT 88920020 SPACE 5 89010020 AGO .EXIT 89100020 .PH3 ANOP 89190020 * SUBROUTINE 'LOCNXT' 89280020 * GIVEN A DICT POINTER, RETURNS DICT POINTER OF NEXT ENTRY 89370020 * INPUT REG1= INPUT DICT POINTER 89460020 * OUTPUT REG1= DICT POINTER OF NEXT ENTRY 89550020 * REG2= STARTING ADDR OF ITS ATTRIB 89640020 * REG3= STARTING ADDR OF ITS NAME CNT 89730020 * R0=A(SEGMENT START) OUTPUT FROM DINCOR 89820020 * IF THE BYTE FOLLOWING THE CURRENT ENTRY =0, THEN THE NEXT ENTRY 89910020 * IS IN THE NEXT SEGMENT (SEE DE200) 90000020 * 90090020 * 90180020 DS 0F 90270020 USING LOCNXT,R15 90360020 LOCNXT EQU * 90450020 ST R12,D2SV12 90540020 L R12,D2RG12 90630020 STM R14,R15,D2SV14 90720020 ST R4,DL4 90810020 * LOCATE ENTRY IN DICT 90900020 LR R2,R1 90990020 L R15,DLDINC 91080020 BALR R14,R15 91170020 L R15,D2SV15 91260020 ST R2,DWORK SAVE A(ENTRY START) 91350020 *** 91440020 *** CAREFUL DO NOT USE R0 AS A WORK REGISTER UNTIL AFTER DT210 91530020 *** 91620020 A R0,D512 SET R0 TO SEGMENT START + 512 91710020 * COMPUTE LOC OF END OF ENTRY 91800020 TM 0(R2),DMPFXT 91890020 BC ZERO,DT100 UPDATE PAST ANY CODE 91980020 LA R2,3(R2) 92070020 BC MIXED,DT100 92160020 LA R2,3(R2) 92250020 DT100 SR R4,R4 92340020 IC R4,0(R2) SET R4=NAME CNT 92430020 LA R2,1(R4,R2) SET R2=A(ATTRIB) 92520020 * 92610020 * ATTRIB CNT IN 1ST 4 BITS OF 1ST BYTE UNLESS REPORT OR CONDITION 92700020 * NAME ATTRIBUTES 92790020 * THEN 1ST 4 BITS=0 AND BYTE NO. 6= CNT OF VARIABLE PART OF 92880020 * ATTRIBUTES AND DOES NOT INCLUDE ITSELF 92970020 * (IE TOTAL NO OF ATTRIB. BYTES = N+7) 93060020 IC R4,0(R2) 93150020 TM 0(R2),DMATRB 93240020 BC NOTZER,DT200 93330020 TM 0(R2),CNDNM IS IT CONDITION NAME 93420020 BO ENTCND YES 93510020 LA R2,1(R2) ADD 1 FOR REPORT 93600020 ENTCND LA R2,6(R2) 93690020 IC R4,0(R2) 93780020 LA R2,1(R2,R4) ADD 1, CNT DOES NOT INCL ITSELF 93870020 BC UNCOND,DT210 93960020 DT200 CLI 0(R2),X'9A' 94050020 BE DT250 YES 94140020 CLI 0(R2),X'98' RANDOM PROCESSING 94230020 BNE DT260 NO 94320020 DT250 SR R4,R4 YES GET COUNT 94410020 IC R4,8(R2) 94500020 A R4,FDCNT ADD FIXED COUNT 94590020 DT260 SRL R4,4 94680020 LA R2,0(R2,R4) CNT DOES NOT INCL ITSELF 94770020 * 94860020 * NOW REG2= A(1ST BYTE AFTER ENTRY) 94950020 DT210 CR R2,R0 R0= END OF SEGMENT + 1 95040020 BC EQ,DT300 BRANCH IF NO SPACE LEFT IN CURRENT SECTION 95130020 TM 0(R2),DMBYT NEXT BYTE=O MEANS NO ENTRY FOLLOWS 95220020 BC NOTZER,DT400 95310020 * 95400020 * NEXT ENTRY IN NEXT SEGMENT, COMPUTE DICT POINTER 95490020 DT300 N R1,DMSECT MASK OUT ALL BUT SECT NO 95580020 LA R1,512(R1) INCR. SECT. NO. 95670020 LR R2,R1 95760020 L R15,DLDINC COMPUTE CORRES. DICT ADDR= R2 95850020 BALR R14,R15 95940020 L R15,D2SV15 96030020 BC UNCOND,DT500 96120020 * 96210020 * NEXT ENTRY IN SAME SEGMENT, COMPUTE DICT POINTER 96300020 DT400 LR R3,R2 COMPUTE R3= INPUT ENTRY SIZE 96390020 S R3,DWORK DWORK=A(ENTRY START) 96480020 AR R1,R3 96570020 * 96660020 * COMPUTE A(BCD NAME), A(ATTRIB) OF NEXT ENTRY 96750020 DT500 TM 0(R2),DMPFXT 96840020 BC ZERO,DT550 96930020 LA R2,3(R2) 97020020 BC MIXED,DT550 97110020 LA R2,3(R2) 97200020 DT550 LR R3,R2 SET R3= A(NAME) 97290020 IC R4,0(R2) 97380020 LA R2,1(R2,R4) SET R2=A(ATTRIB) 97470020 * 97560020 L R4,DL4 97650020 * REG13 IS NEVER USED, NO NEED TO SAVE IT 97740020 L R14,D2SV14 PRECEDE LOAD OF REG12 97830020 L R12,D2SV12 97920020 BCR UNCOND,R14 98010020 * 98100020 D2RG12 DC A(PBEG12) 98190020 D2SV12 DS F 98280020 CNDNM EQU X'08' 98370020 * 98460020 EJECT 98550020 .EXIT ANOP 98640020 MEND 98730020 ./ ADD SSI=01030053,SOURCE=1,NAME=AFBUFTYP MACRO 09000000 &BUFTYP AFBUFTYP &P,&IS,&IM,&R,&GS,&GM 18000000 AF&BUFTYP.FW DS 0CL6 . ORIGIN OF BUFFER TYPES BY MACRO/FILE 27000000 DC YL1(((AF&P.FW-BUFTABFW)/L'BUFTABFW)*16) . POINT 36000000 DC YL1(((AF&IS.FW-BUFTABFW)/L'BUFTABFW)*16) . INSERT S 45000000 DC YL1(((AF&IM.FW-BUFTABFW)/L'BUFTABFW)*16) . INSERT M 54000000 DC YL1(((AF&R.FW-BUFTABFW)/L'BUFTABFW)*16) . REPLACE 63000000 DC YL1(((AF&GS.FW-BUFTABFW)/L'BUFTABFW)*16) . GET S 72000000 DC YL1(((AF&GM.FW-BUFTABFW)/L'BUFTABFW)*16) . GET M 81000000 MEND 90000000 ./ ADD SSI=21460067,NAME=AFCTLDS,SOURCE=0 MACRO 01000019 AFCTLDS 02000019 AFCTLDS DSECT , 03000019 *C310000,430000 A45668 03500026 * 04000019 * FILE CONTROL INFORMATION. THIS CONTROL BLOCK IS EITHER IN THE FILE 05000019 * BOX FOR A PARTICULAR LINE (PRIVATE FILE), OR IN THE KONSTANT 06000019 * BOX (FOR GLOBAL FILES). 07000019 * 08000019 GBQCTLFW DS 2A . GLOBAL FILE ENQUEUEING CONTROL 09000019 FCTLFW DS 0CL16 . PRIMARY FILE CONTROL INFORMATION 10000019 NDXRTKFW DC F'0' . RACH OF INDEX TRACK 11000019 BALNDXFW DC H'0' . INDEX TRACK TRACK BALANCE 12000019 TKLSTZFW DC X'0' . SIZE OF TRACK 13000019 NUMSEGFW DC X'0' . # OF SEGMENTS IN INDEX RECORD 14000019 NULLFCFW DS 0CL16 . NULL FILE CONTROL 15000019 SEGNUMFW DC X'0' . PRESENT SEGMENT NUMBER 16000019 BUFNUMFW DC X'0' . BUFFER TYPE NUMBER 17000019 BUFATT EQU X'08' . BUFFER ATTACHED TO FILE 18000019 PTRKDPFW DC X'0' . TRACK LIST DISP OF PRESENT TRACK 19000019 STATUSFW DC X'0' . FILE STATUS 20000019 DELETE EQU B'10000000' . SEGMENT DELETE PENDING 21000019 INSERT EQU B'01000000' . SEGMENT INSERT PENDING 22000019 LASTKEY EQU B'00100000' . LAST KEY IN SEGMENT CHANGED 23000019 SEGDATA EQU B'00010000' . SEGMENT DATA CHANGED 24000019 RECPEND EQU B'00001000' . RECORD CHAIN UPDATE PENDING 25000019 LASTMOVE EQU B'00000100' . LAST RECORD OF SEGMENT MOVED 26000019 FRSTMOVE EQU B'00000010' . FIRST RECORD OF SEGMENT MOVED 27000019 AVLRECFW DC F'0' . RACH OF AVAILABLE RECORD 28000019 INSRTOVF EQU B'10000000' . INSERT OVERFLOW CONDITION 29000019 EOS EQU B'10000000' . END OF SEGMENT FLAG 30000019 FNAMEFW DS 0CL48 FILE NAME AND CHECKPOINT AREA 31000026 LSTRECFW DC F'0' . RACH OF LAST RECORD PROCESSED 32000019 PRSRRFW DS 0H . R(F)R(L) OF PRESENT SEGMENT 33000019 SEGR1FW DC X'0' . PRESENT FIRST RECORD IN SEGMENT 34000019 SEGRFFW DC X'0' . POSITION OF EOS IN TRACK CHAIN 35000019 ATRKDPFW DC X'0' . TRACK LIST DISP OF AVAIL REC 36000019 AVAILNFW DC X'0' . NUM OF AVAILABLE RECORDS ON TRK 37000019 * 38000019 * VARIABLE PORTION OF CONTROL INFORMATION 39000019 * 40000019 VARINFO DS 0F . 41000019 * UPDATE LEVEL MODE (CHAIN RECORD UPDATE LEVEL) 42000019 RCHANFW DS CL48 43000026 ORG VARINFO 44000019 * INDEX RECORD UPDATE MODE 45000019 AVAIL1FW DC X'0' . RECORD NUMBER OF FIRST AVAIL REC 46000019 INSEGFW DC XL3'0' . INSERT SEGMENT DATA #RR 47000019 INSKEYFW DC XL8'0' . INSERT SEGMENT KEY 48000019 SCHPOSFW DC X'0' . 49000019 REPSEGFW DC XL3'0' . REPLACEMENT SEGMENT DATA #RR 50000019 REPKEYFW DC XL8'0' . REPLACEMENT SEGMENT KEY 51000019 ORG VARINFO 52000019 * POINT MODE (FIRST RECORD MOVED & SEARCH NEXT TRACK) 53000019 XTRKDPFW DS 0C . TRACK LIST POSITION OF EXTRA TRK. 54000019 PRETRKFW DC F'0' . XACH OF PREVIOUS SEGMENT 55000019 XAVAILFW DC F'0' . RACH OF AVAILABLE RECORD 56000019 SCSGNMFW DS 0C . SEGMENT NUMBER OF NEXT SEGMENT 57000019 SCHTRKFW DC F'0' . XACH OF NEXT (OR SEARCH) SEGMENT 58000019 SCHRRFW DC H'0' . FIRST & LAST RECS OF NEXT SEG 59000019 PRERRFW DC H'0' . FIRST & LAST RECS OF PREV SEG 60000019 SCHKEYFW DC XL8'0' . LAST KEY OF SEARCH SEGMENT 61000019 ORG VARINFO 62000019 * SEARCH MODE 63000019 SCHOPTFW DS 0C . SEARCH OPTIONS 64000019 SKEYPTFW DC F'0' . KEY POINTER 65000019 * 66000019 MEND 67000019 ./ ADD SSI=01030060,SOURCE=1,NAME=AFIOEQU MACRO 01000000 AFIOEQU 02000000 * 03000000 * REGISTER DEFINITIONS FOR ACTIVE FILE I/O ACCESS MODULES. 04000000 * 05000000 SAVERG EQU 7 06000000 KBXRG EQU 8 07000000 LBXRG EQU 12 08000000 BASERG EQU 10 09000000 FBXRG EQU 12 10000000 * 11000000 * PRIMARY RAFIO REGISTER DEFINITIONS 12000000 * 13000000 GR0RG EQU 0 . WORK REGISTERS 14000000 GR1RG EQU 1 . 15000000 GR2RG EQU 2 . 16000000 GR3RG EQU 3 . 17000000 INTLNKRG EQU 4 . LOWEST LEVEL LINKAGE AND WORK 18000000 CCWRG EQU 5 . CCW LIST BASE 19000000 SRCHRG EQU 6 . SEARCH ARGUMENT LIST BASE 20000000 ICRG EQU SAVERG . INSERT CHARACTER REGISTER 21000000 AFWRG EQU 9 22000000 LINK1RG EQU 14 . PRIMARY LINKAGE REGISTER 23000000 LINK2RG EQU 15 . SECONDARY LINKAGE REGISTER 24000000 * 25000000 * SECONDARY RAFIO REGISTER DEFINITIONS 26000000 * 27000000 AFPARG EQU GR0RG . USER PARAMENTER REGISTER 28000000 GRERG EQU GR0RG . EVEN REGISTER 29000000 GRORG EQU GR1RG . ODD REGISTER 30000000 GRDRG EQU GR2RG . DIVISOR WORK REGISTER 31000000 GRD2RG EQU GR3RG . SECOND DIVIDE REGISTER 32000000 INCRG EQU GR1RG . INCREMENT AND MASK REG. FOR ALLOCATOR 33000000 CYLERG EQU GR2RG . EVEN REGISTER FOR TRACK ALLOCATION 34000000 CYLORG EQU GR3RG . ODD REGISTER FOR TRACK ALLOCATION 35000000 HEADRG EQU INTLNKRG . WORK REGISTER FOR ALLOCATOR 36000000 * 37000000 * REGISTER DEFINITIONS FOR APPENDAGES. 38000000 * 39000000 APIOBRG EQU 2 . POINTER TO IOB 40000000 APW1RG EQU 10 . APPENDAGE WORK REG. CCW POINTER 41000000 APW2RG EQU 11 . KONBOX POINTER 42000000 APW3RG EQU 12 . LINE BOX POINTER 43000000 APRETRG EQU 14 . APPENDAGE RETURN REGISTER 44000000 APBASERG EQU 15 . PROGRAM BASE REGISTER 45000000 * 46000000 * CCW FLAG BITS. 47000000 * 48000000 CD EQU B'10000000' . CHAIN DATA 49000000 CC EQU B'01000000' . CHAIN COMMAND 50000000 SILI EQU B'00100000' . SUPPRESS INCORRECT LENGTH INDICATOR 51000000 SKIP EQU B'00010000' . SUPPRESS TRANSFER OF INFORMATION 52000000 PCI EQU B'00001000' . PROGRAM CONTROLLED INTERRUPT 53000000 * 54000000 * CCW COMMAND CODES. 55000000 * 56000000 READHA EQU 26 . READ HOME ADDRESS 57000000 READCKD EQU 30 . READ COUNT-KEY-DATA 58000000 READKD EQU 14 . READ KEY-DATA 59000000 READD EQU 6 . READ DATA 60000000 WRITECKD EQU 29 . WRITE COUNT-KEY-DATA 61000000 WRITEKD EQU 13 . WRITE KEY-DATA 62000000 WRITED EQU 5 . WRITE DATA 63000000 SRCHIDEQ EQU 49 . SEARCH ID EQUAL 64000000 SRCHIDHI EQU X'51' . SEARCH COUNT/ID HIGH 65000000 SRCHKEEQ EQU 41 . SEARCH KEY EQUAL 66000000 TIC EQU 8 . TRANSFER IN CHANNEL 67000000 READC EQU 18 . READ COUNT 68000000 ERASE EQU X'11' . ERASE TO END OF TRACK 69000000 * 70000000 * USER PARAMETER AND COMPLETION BITS (AFPARFS BITS). 71000000 * 72000000 AFIOERR EQU B'11000000' . ACTIVE FILE I/O ERROR 73000000 AFXCPTN EQU B'01000000' . ACTIVE FILE EXCEPTION CONDITION 74000000 MACOMP2 EQU B'00100000' . REENTRY MACRO INTERPRETER 75000000 MACOMP1 EQU B'00010000' . PROCEDE TO NEXT SEGMENT 76000000 BYRECNUM EQU B'10000000' . SEARCH BY RECORD NUMBER 77000000 LAST EQU B'01000000' . POSITIONED TO LAST RECORD OF FILE 78000000 NEXT EQU B'01000000' . PROCESS NEXT RECORD 79000000 HIGHEQ EQU B'01000000' . KEY REQUESTED IS HIGH OR EQUAL 80000000 MULTIPLE EQU B'00100000' . PROCESS MULTIPLE RECORDS 81000000 REPOST2 EQU B'00100000' . POSITION IS AFTER LAST RECORD OF SEG. 82000000 GLOBAL EQU B'00010000' . REQUEST IS FOR GLOBAL FILE 83000000 REPOST1 EQU B'00010000' . POSITION IS BETWEEN FIRST AND LSST 84000000 XLOOSIV EQU B'00001000' . EXCLUSIVE CONTROL FOR GLOBAL FILES 85000000 READREC EQU B'00000100' . READ REFERENCED RECORD 86000000 READKEY EQU B'00000010' . READ REFERENCED KEY 87000000 BEFORE EQU B'00000001' . FINAL POSITION IS BEFORE LAST PROCESS 88000000 OLDFILE EQU B'00000001' . CREATE MACRO OPTION 89000000 * 90000000 MEND 91000000 ./ ADD SSI=01030060,SOURCE=1,NAME=AFRECTYP MACRO 10000000 &RECTYP AFRECTYP &R 20000000 AF&RECTYP.FW DC YL1(AF&R.FW-RECTABFW) .INDEX POINTER TO RECORD DISCRIPT 30000000 MEND 40000000 ./ ADD SSI=01010781,SOURCE=1,NAME=AMAMAIN DCBERAEX DC A(DCBERREX) EXT MSG 01000018 DC F'33' SIZE 02000018 OPENERR1 DC A(OPENERR) OPEN MSG 03000018 DC F'28' SIZE 04000018 DMSG900X DC A(DMSG900) CORE MSG 05000018 DC F'44' SIZE 06000018 * 07000013 DMSG901X DC A(DMSG901) BFR MSG 08000018 DC F'39' SIZE 09000018 * 10000013 DMSG902X DC A(DMSG902) BFR MSG 11000018 DC F'47' SIZE 12000018 * 13000013 DMSG903X DC A(DMSG903) RSA MSG 14000018 DC F'33' SIZE 15000018 * 16000013 DMSG904X DC A(DMSG904) TREE MSG 17000018 DC F'44' SIZE 18000018 * 19000013 DMSG905X DC A(DMSG905) MOVE MSG 20000018 DC F'34' SIZE 21000018 * 22000013 DMSG906X DC A(DMSG906) DCB MSG 23000018 DC F'33' SIZE 24000018 * 25000013 DMSG907X DC A(DMSG907) CCW MSG 26000018 DC F'33' SIZE 27000018 * 28000013 DMSG908X DC A(DMSG908) IOB MSG 29000018 DC F'36' SIZE 30000018 * 31000013 DMSG909X DC A(DMSG909) OPEN LIST MSG 32000018 DC F'35' SIZE 33000018 * 34000013 DCBERREX DC CL27'IER044I - EXIT E INVALID ' EXIT MSG 35000018 DC CL06'OPTION' OPTION 36000018 OPENERR DC CL28'IER063A - OPEN ERR' OPEN MSG 37000018 * 38000013 DMSG900 DC CL29'IER900I - GENERATED CORE END ' CORE MSG 39000018 DC CL07'ADDR - ' ADDR 40000018 DMSG900A DC CL8' ' ACT ADDR 41000018 * 42000013 DMSG901 DC CL31'IER901I - INPUT BFR TBL ADDR - ' BFR MSG 43000018 DMSG901A DC CL8' ' ACT ADDR 44000018 * 45000013 DMSG902 DC CL28'IER902I - OUTPUT BFR ADDR - ' BFR MSG 46000018 DMSG902A DC CL8' ' ACT ADDR 47000018 DC CL03' , ' COMMA 48000018 DMSG902B DC CL8' ' ACT ADDR 49000018 * 50000013 * 51000013 DMSG903 DC CL25'IER903I - RSA TBL ADDR - ' RSA MSG 52000018 DMSG903A DC CL8' ' ACT ADDR 53000018 * 54000013 DMSG904 DC CL24'IER904I - TREE ADR FROM ' TREE MSG 55000018 DMSG904A DC CL8' ' ACT ADDR 56000018 DC CL04' TO ' TO 57000018 DMSG904B DC CL8' ' ACT ADDR 58000018 * 59000013 DMSG905 DC CL26'IER905I - MOVE RTN ADDR - ' MOVE MSG 60000018 DMSG905A DC CL8' ' ACT ADDR 61000018 * 62000013 DMSG906 DC CL25'IER906I - DCB TBL ADDR - ' DCB MSG 63000018 DMSG906A DC CL8' ' ACT ADDR 63600018 * 65000013 DMSG907 DC CL25'IER907I - O/P CCW ADDR - ' CCW MSG 66000018 DMSG907A DC CL8' ' ACT ADDR 67000018 * 68000013 DMSG908 DC CL28'IER908I - OUTPUT IOB ADDR - ' IOB MSG 69000018 DMSG908A DC CL8' ' ACT ADDR 70000018 * 71000013 DMSG909 DC CL27'IER909I - OPEN LIST ADDR - ' 72000018 DMSG909A DC CL8' ' ACT ADDR 73000018 * 74000013 ./ ADD SSI=01010793,SOURCE=1,NAME=AMBMAIN DCBERAEX DC A(DCBERREX) EXIT MSG 02000018 DC F'33' SIZE 04000018 OPENERR1 DC A(OPENERR) OPEN MSG 06000018 DC F'28' SIZE 08000018 DMSG920X DC A(DMSG920) CORE MSG 10000018 DC F'44' SIZE 12000018 DMSG921X DC A(DMSG921) INP BFR MSG 14000018 DC F'39' SIZE 16000018 DMSG922X DC A(DMSG922) OUT BFR MSG 18000018 DC F'47' SIZE 20000018 DMSG923X DC A(DMSG923) MOVE RTN MSG 22000018 DC F'34' SIZE 24000018 DMSG924X DC A(DMSG924) DCB MSG 26000018 DC F'33' SIZE 28000018 DMSG925X DC A(DMSG925) CCW MSG 30000018 DC F'33' SIZE 32000018 DMSG926X DC A(DMSG926) JOB MSG 34000018 DC F'33' SIZE 36000018 DMSG927X DC A(DMSG927) CCW MSG 38000018 DC F'33' SIZE 40000018 DMSG928X DC A(DMSG928) SEQ MSG 42000018 DC F'35' SIZE 44000018 DCBERREX DC CL27'IER044I - EXIT E INVALID ' EXIT MSG 46000018 DC CL06'OPTION' OPTION 48000018 OPENERR DC CL28'IER063A - OPEN ERR' OPEN MSG 50000018 DMSG920 DC CL29'IER920I - GENERATED CORE END ' CORE MSG 52000018 DC CL07'ADDR - ' ADDR 54000018 DMSG920A DC CL8' ' ACT ADDR 56000018 DMSG921 DC CL31'IER921I - INPUT BFR TBL ADDR -' BFR MSG 58000018 DMSG921A DC CL8' ' ACT ADDR 60000018 DMSG922 DC CL28'IER922I - OUTPUT BFR ADDR - ' BFR MSG 62000018 DMSG922A DC CL8' ' ACT ADDR 64000018 DC CL03' , ' COMMA 66000018 DMSG922B DC CL8' ' ACT ADDR 68000018 DMSG923 DC CL26'IER923I - MOVE RTN ADDR - ' MOVE RTN MSG 70000018 DMSG923A DC CL8' ' ACT ADDR 72000018 DMSG924 DC CL25'IER924I - DCB TBL ADDR - ' DCB MSG 74000018 DMSG924A DC CL8' ' ACT ADDR 76000018 DMSG925 DC CL25'IER925I - O/P CCW ADDR - ' CCW MSG 78000018 DMSG925A DC CL8' ' ACT ADDR 80000018 DMSG926 DC CL25'IER926I - IOB TBL ADDR - ' IOB MSG 82000018 DMSG926A DC CL8' ' ADDR 84000018 DMSG927 DC CL25'IER927I - I/P CCW ADDR - ' CCW MSG 86000018 DMSG927A DC CL8' ' CT ADDR 88000018 DMSG928 DC CL27'IER928I - TOTAL NO. SEQ - ' SEQ MSG 90000018 DMSG928A DC CL8' ' ACT ADDR 94000018 ./ ADD SSI=01010781,SOURCE=1,NAME=AMCMAIN DCBERAEX DC A(DCBERREX) ADD OF EXIT MSG 02000018 DC F'33' LENGTH 33 04000018 * 06000013 OPENERR1 DC A(OPENERR) OPEN ERR MSG 08000018 DC F'28' LENGTH 28 10000018 DMSG940X DC A(DMSG940) CORE MSG 12000018 DC F'44' LENGTH 44 14000018 * 16000013 DMSG941X DC A(DMSG941) BFR MSG 18000018 DC F'39' LENGTH 39 20000018 * 22000013 DMSG942X DC A(DMSG942) BFR MSG 24000018 DC F'47' LENGTH 47 26000018 * 28000013 DMSG943X DC A(DMSG943) MOVE RTN MSG 30000018 DC F'34' LENGTH 34 32000018 * 34000013 DMSG944X DC A(DMSG944) DCB MSG 36000018 DC F'33' LENGTH 33 38000018 * 40000013 DMSG945X DC A(DMSG945) CCW MSG 42000018 DC F'33' LENGTH 33 44000018 * 46000013 DCBERREX DC CL27'IER044I - EXIT E INVALID ' EXIT ERR MSG 48000018 DC CL06'OPTION' OPTION 50000018 * 52000013 OPENERR DC CL28'IER063A - OPEN ERR' OPENERR MSG 54000018 DMSG940 DC CL29'IER940I - GENERATED CORE END ' CORE MSG 56000018 DC CL07'ADDR - ' ADDR 58000018 DMSG940A DC CL8' ' ACT ADDR 60000018 * 62000013 DMSG941 DC CL31'IER941I - INPUT BFR TBL ADDR - ' BUFR MSG 64000018 DMSG941A DC CL8' ' ACT ADDR 66000018 * 68000013 DMSG942 DC CL28'IER942I - OUTPUT BFR ADDR - ' BUFR MSG 70000018 DMSG942A DC CL8' ' ACT ADDR 72000018 DC CL03' , ' COMMA 74000018 DMSG942B DC CL8' ' SECOND ACT ADDR 76000018 * 78000013 DMSG943 DC CL26'IER943I - MOVE RTN ADDR - ' MOVE MSG 80000018 DMSG943A DC CL8' ' ACT ADDR 82000018 * 84000013 DMSG944 DC CL25'IER944I - DCB TBL ADDR - ' DCB MSG 86000018 DMSG944A DC CL8' ' ACT ADDR 88000018 DMSG945 DC CL25'IER945I - I/P CCW ADDR - ' CCW MSG 90000018 DMSG945A DC CL8' ' ACT ADDR 92000018 * 94000013 ./ ADD SSI=01012320,SOURCE=1,NAME=ANYMOD MACRO 10000020 &NAME ANYMOD &LOAD=,&CALL=,&DELETE=,&LIST=,&C=8 20000020 &NAME BRING LOAD=&LOAD,CALL=&CALL,DELETE=&DELETE,LIST=&LIST,C=&C 30000020 MEND 40000020 ./ ADD SSI=01030060,SOURCE=1,NAME=APPNDGDS MACRO 07000000 APPNDGDS 14000000 * 21000000 * APPENDAGE VECTOR TABLE FORMAT 28000000 * 35000000 APPNDGDS DSECT , APPENDAGE VECTOR TABLE 42000000 EOXAPPAD DS F END OF EXTENT APPENDAGE 49000000 SIOAPPAD DS F START I/O APPENDAGE 56000000 PCIAPPAD DS F PROGRAM CONTROL INTERUPTION APP. 63000000 CEAPPAD DS F CHANNEL END APPENDAGE 70000000 ABNAPPAD DS F ABNORMAL END APPENDAGE 77000000 MEND 84000000 ./ ADD SSI=01012021,SOURCE=1,NAME=AQCTL MACRO 10000000 AQCTL 20000000 SVC 102 . TCAM CROSS-PARTITION 30000000 * COMMUNICATIONS ROUTINE 40000000 MEND 50000000 ./ ADD SSI=01011940,SOURCE=1,NAME=ASRMAC MACRO 01000015 ASRMAC 02000015 SPACE 02200015 * THIS MACRO IS USED BY MVT MODULES AND ALL SYSTEM INDEPENDENT MODULES 02400015 SPACE 02600015 ********************************************************************* 03000015 * * 04000015 * 7/6/71 LEVEL 22 * 05000021 * * 06000015 ********************************************************************* 07000015 * * 08000015 ***** A S R C O M M U N I C A T I O N A R E A ***** 09000015 * * 10000015 DS 0D 11000015 IGFDCB EQU * ENTRY FOR 1ST LOAD MODULE 12000015 COMENVCK DC CL8'IGFASR0B' 1ST LOAD MODULE OF ASR 13000015 COMPDAR EQU * START PDAR AREA 14000015 PDARSTAT DC X'0' 15000015 PDARTCB DC 3X'0' 16000015 PDARTAB DC 8F'0' PDAR OUTPUT AREA 2K 17000018 COMNEST DC V(IEA0IO01) MVT-IOS NEST SWITCH 2K 18000018 PDARCUA DC 9F'0' 20000015 COMERXNT DC A(0) 21000015 IGFMOD EQU * 1ST BYTE OF NEXT FIELD IS CPU MODEL NUMBER 22000015 COMCVT DC V(IEACVT) ADDR OF CVT 23000015 COMCHASG DC V(IFBACTA) POINTER TO CHANNEL ASSIGNMENT MODU 24000015 DC A(0) 25000015 IGFBLDL EQU * ADDRESS OF BLDL 27000015 COMBLDL DC A(0) 28000015 IGFSVBLD EQU * ADDRESS OF SVC BLDL SVBLD 28050021 COMSVBLD DC A(0) SVBLD 28100021 IGFSVCQ EQU * ADDRESS OF QUEUE 29000015 COMSVCQ DC A(0) OF RESIDENT 3 AND 4 SVCS 30000015 COMERIOB DC V(IEAERWA) MVT - IOB FOR ERROR XSNT AREA 33000015 COMSBAD DC F'0' ADDR OF FAILING STORAGE LOCATION 34000015 COMSIRB DC V(SIRB) SYSTEM SIRB POIMNTER 35000015 DC F'0' SPARE WORD 35050021 IGFNUC01 EQU * LIST OF REFRESHABLE NUCLEUS MODULES 36000015 DC D'0' 37000015 COMNUC DC 2D'0' NUCLEUS DATA 38000015 COMPSA DC 16D'0' PERMANENT STORAGE SAVE AREA 39000015 COMSYSRS DC F'0' SYSRES ADDR AND DEVICE TYPE 40000015 COMCNSL DC F'0' ACTIVE SYSTEM CONSOLE ADDRESS AND TYPE 40200015 COMIOQ DC F'0' POINTER TO I/O INTERRUPT SAVE QUEUE 40400015 COMPRNT DC F'0' ADDRESS OF CONSOLE PRINT ROUTINE 40600015 COMMSG0 DC 2D'0' CONSOLE ROUTINE MESSAGE BUFFERS 40700015 COMMSG1 DC 2D'0' 40800015 COMEXADR DC F'0' EXECUTE INSTR ADDR FOR IRE 40900015 COMOBREX DC F'0' ADDRESS OF OBR EXIT ROUTINE 40940015 COMLEV0A DC X'0' THESE ARE MODULE CHANGE LEVEL FIELDS TO BE 40944015 COMLEV1A DC X'0' LAODED BY EACH MODULE AS EACH MODULE IS 40948015 COMLEV0B DC X'0' EXECUTED 40952015 COMLEV0C DC X'0' 40956015 COMLEV1C DC X'0' 40960015 COMLEV2C DC X'0' 40964015 COMLEV3C DC X'0' 40968015 COMLEV0D DC X'0' 40972015 COMLEV1D DC X'0' 40976015 COMLEV2D DC X'0' 40980015 COMLEV00 DC X'0' 40984015 COMLEV01 DC X'0' 40988015 COMLEV02 DC X'0' 40990021 COMLEV10 DC X'0' 40992015 COMLEV20 DC X'0' 40996015 COMMSF DC X'0' MULTI-SYSTEM INFOR.BYTE MP 41696017 * BIT 0 UNUSED 2K 41766018 * 1 UNUSED 2K 41836018 * 2 UNUSED 2K 41906018 * 3 MULTI PROCESSOR MODE 2K 41976018 * 4 UNUSED 2K 42046018 * 5 SOLID STORAGE FAILURE 2K 42116018 * 6 CPU RECONFIGURE 2K 42186018 * 7 PARTITION CPU 2K 42256018 COMLEV2K DC X'0' STORAGE RECONFIGURATION 2K 42326018 * MP 42396017 * MP 43096017 ***** E X P A N S I O N A R E A MP 43796017 * MP 44496017 COMSPARE DC 53X'0' SPARE 45196021 * * 46000015 ***** A S R R E C O R D E N T R Y B U I L D A R E A ***** 47000015 * * 48000015 CTFLDID DC XL5'0' COUNT FIELD 49000015 CTFLDKEY DC X'00' KEY LENGTH 50000015 CTFLDDL DC XL2'0000' DATA LENGTH FOR RECORD ENTRY 51000015 * 52000015 REKEY DC X'0000' RECORD ENTRY KEY 53000015 * 54000015 RELABEL DC 3X'0' LABEL 55000015 REFORMT DC X'0' RECORD ENTRY FORMAT TYPE 56000015 REMODNUM DC X'00' CPU MODEL 65 57000015 RETYPE DC X'0' TYPE OF ERROR 58000015 RECTLIND DC XL2'0000' EREP CONTROL INDICATORS 59000015 REDATE DC F'0' DATE OF RECORD 60000015 RETIME DC F'0' TIME OF RECORD 61000015 REPROGID DC D'0' ACTIVE PROGRAM ID 62000015 REMCOPSW DC D'0' MACHINE CHECK OLD PSW 63000015 REAIOU DC 4F'0' CH/UNIT ADR OF ACTIVE UNITS (MAX 8) 64000021 RECHASSG DC D'0' CHANNEL TYPE ASSIGNMENTS 65000021 REENVCHK DC 1D'0' ENVIRONMENT CHECK DATA 66000015 REROSCHK DC 3D'0' ROS CHECK DATA 67000015 REMEST DC 14D'0' MEMORY STATUS CHECKER DATA 68000015 REPDAR DC 3D'0' PROGRAM DAMAGE ASSESSMENT DATA 69000015 * 70000015 RERETRY EQU * INSTRUCTION RETRY DATA 71000015 ISUM1 DC 2X'0' TABLE 1 AREA 72000015 ISUMFAIL DC 6X'0' FAILING INSTRUCTION 73000015 ISUM2 DC 2X'0' TABLE 2 AREA 74000015 ISUMROS DC 2X'0' ROS ADDRESS 75000015 ISUMFADR DC F'0' FAILING INSTRUCTION ADDRESS 76000015 ISUMBAL DC F'0' ALT INSTR ADDR OR BAL 77000015 ISUMBAD DC F'0' BAD OPERAND ADDRESS 78000015 * 79000015 REGSGPR DC 8D'0' GPR CONTENTS 80000015 REGSFPR DC 4D'0' FPR CONTENTS 81000015 REGPARGP DC D'0' GPR PARITY INDICATORS 82000015 REGPARFP DC F'0' FPR PARITY INDICATORS 83000015 TEMPSPRE DC F'0' TEMPORARY SPARE TO INSURE DBLWRD 84000015 RECPULOG DC 22D'0' CPU HARDWARE LOGOUT AREA 85000015 * 86000015 ***** E X P A N S I O N A R E A F O R L O G O U T 87000015 * 88000015 RESPARE DC 72C'0' 89000021 * 90000015 * * 90060015 ***** C H A N N E L I N B O A R D R E P O S I T I O N S ***** 90120015 * 90180015 * THESE POSITIONS ARE USED WHEN HANDLING A CHANNEL INBOARD ERROR, 90240015 * WITH MCH IN THE SYSTEM, BUT NO CCH. MCH FORMS AND RECORDS A SER- 90300021 * TYPE RECORD VIA ITS ERROR RECORDER MODULE. 90360015 SPACE 2 90420015 RECCW1 EQU RELABEL+24 FIRST CCW OF FAILING CHAIN 90480015 RECCW2 EQU RELABEL+32 FAILING CCW 90540015 RECSW EQU RELABEL+40 CHANNEL STATUS WORD 90600015 REACTIO EQU RELABEL+48 ACTIVE I/O UNITS 90660015 RECHASG EQU RELABEL+64 CHANNEL TYPE ASSIGNMENTS 90720021 REERPIB EQU RELABEL+72 MP 90770017 RECUA EQU RELABEL+80 MP 90820017 RECHSTAT EQU RELABEL+82 MP 90870017 REIOLOG EQU RELABEL+84 MP 90920017 MEND 91000015 ./ ADD SSI=01031772,SOURCE=1,NAME=ASRMAC48 MACRO 00010020 ASRMAC48 00020020 * MODEL DEPENDENT RMS COMMUNICATIONS AREA 00030020 * LEVEL 01 1/29/70 00040020 * 00050020 DS 0D 00060020 * 00070020 FILLER DS XL6 ALIGN DAMAGE ASSESSMENT LENGTH 00080020 DASMTLTH DS XL2'004A' ASSESSMENT LENGTH FIELD 00090020 * 00100020 MEND 00110020 ./ ADD SSI=01012615,SOURCE=1,NAME=ASRMAC85 MACRO 00400018 ASRMAC85 00800020 * THIS MACRO REPRESENTS THE MODULE 85 DEPENDENT SECTION 01200020 * FOR ALL SUPPORTED M/85 SYSTEMS 01600020 SPACE 02000018 ********************************************************************* 02400018 * * 02800018 ** 8/27/70 LEVEL 3 03200020 * * 03600018 ********************************************************************* 04000018 * * 04400018 ***** R M S / 85 C O M M U N I C A T I O N A R E A **** 04800020 SPACE 1 05200018 DS 0D 05600018 COMCHASG DC V(IFBACTA) POINTER TO CHANNEL ASSIGNMENT MODU 17600020 COMSHUT DC F'0' ADDR OF SHUT ROUTINE 4 27600020 COMOBREX DC F'0' ADDR OF OBR EXIT ROUTINE 4 37600020 * * 52400018 ***** R M S R E C O R D E N T R Y B U I L D A R E A ***** 52800018 * * 53200018 CTFLDID EQU COMCHASG+14 5 53600020 CTFLDKEY EQU CTFLDID+5 KEY LENGTH 1 54000018 CTFLDDL EQU CTFLDID+6 DATA LENGTH FOR RECORD ENTRY 2 54400018 REKEY EQU CTFLDID+8 RECORD ENTRY KEY 2 54800018 RELABEL EQU CTFLDID+10 IDENTIFY LABEL FOR MCH OUTPUT 3 55200018 REFORMT EQU CTFLDID+13 RECORD ENTRY FORMAT TYPE 1 55600018 REMODNUM EQU CTFLDID+14 CPU MODEL NUMBER 1 56000018 RETYPE EQU CTFLDID+15 TYPE OF ERROR 1 56400018 RECTLIND EQU CTFLDID+16 EREP CONTROL INDICATORS 2 56800018 REDATE EQU CTFLDID+18 DATE OF RECORD 4 57200018 RETIME EQU CTFLDID+22 TIME OF RECORD 4 57600018 REPROGID EQU CTFLDID+26 ACTIVE PROGRAM ID 8 58000018 REVDOPSW EQU CTFLDID+34 MACHINE CHECK OLD PSW 8 58400020 REAIOU EQU CTFLDID+42 CH/UNIT ADR OF ACTIVE UNITS-MAX 10 20 58800018 RECHASSG EQU CTFLDID+62 CHANNEL TYPE ASSIGNMENTS 4 59200018 REPRIANL EQU CTFLDID+66 PRELIMINARY ANALYSIS REPORT AREA 8 59600018 REBUFREP EQU CTFLDID+74 AREA FOR HIGH SPEED BUFFER ANAL. 24 60000018 REMEST EQU CTFLDID+98 MEMORY ERROR STATUS TABLE 104 60400018 * * 60800018 ***** PROGRAM DAMAGE ASSESSMENT AND REPAIR DATA ***** 61200018 * * 61600018 REPDARV EQU CTFLDID+202 JOB NAME AND STEP NAME 16 62000020 REPDARV1 EQU CTFLDID+218 PDAR ACTION BYTE 1 1 62400020 REPDARV2 EQU CTFLDID+219 PDAR ACTION BYTE 2 1 62800020 REPDARV3 EQU CTFLDID+220 OPERATING SYSTEM STATUS 1 63200020 REPDARV4 EQU CTFLDID+221 SYSTEM LOCATION AFFECTED BYTE 1 1 63600020 REPDARV5 EQU CTFLDID+222 SYSTEM LOCATION AFFECTED BYTE 2 1 64000020 REPDARV6 EQU CTFLDID+223 REQUESTED OPERATOR AWARENESS 1 64400020 REPDARV7 EQU CTFLDID+224 EXPANSION BYTE 1 1 64800020 REPDARV8 EQU CTFLDID+225 EXPANSION BYTE 2 1 65200020 REPDARV9 EQU CTFLDID+226 FAILING LOCATION BEGINING ADDRESS 4 65600020 REPDARVA EQU CTFLDID+230 FAILING LOCATION ENDING ADDRESS 4 66000020 REPDARVB EQU CTFLDID+234 INSTRUCTION ADDRESS AT FAILURE 4 66400020 RERETRY EQU CTFLDID+242 MCH RETRY REPORT AREA 8 66800018 RERMSECC EQU CTFLDID+250 COUNT OF ECC CORRECTED ERR DURING RMS 4 67200018 RERMSHIR EQU CTFLDID+254 COUNT OF HIR SUCCESSFUL ERR DURING RMS 4 67600018 RESTATV EQU CTFLDID+258 MACHINE STATUS BLOCK 68000020 RESMCWV EQU CTFLDID+258 MCW -8 68400020 RELECCV EQU CTFLDID+266 ECC LOG COUNT -4 68800020 RELHIRV EQU CTFLDID+270 HIR LOG COUNT -4 69200020 RETECCV EQU CTFLDID+274 ECC THRESHOLD -4 69600020 RETHIRV EQU CTFLDID+278 HIR THRESHOLD -4 70000020 RESECTV EQU CTFLDID+282 SECTOR DELETION -4 70400020 RESPARV EQU CTFLDID+286 EXPANSION AREA 12 70800020 RECHKCNT EQU CTFLDID+298 COUNT OF GEN BUF AND BDBO CHECKS 4 71200018 TEMPSPRE EQU CTFLDID+302 SPARE AREA 68 71600018 RECPULOG EQU CTFLDID+370 HARDWARE LOGOUT AREA 1504 72000018 REGSGPR EQU CTFLDID+1874 GPR CONTENTS 64 72400018 REGSFPR EQU CTFLDID+1938 FPR CONTENTS 32 72800018 REIOLOG EQU CTFLDID+1970 IO LOG OUT AREA 24 73200018 MEND 80800018 ./ ADD SSI=01011827,SOURCE=1,NAME=ASRMFT MACRO 00900015 ASRMFT 01800015 SPACE 02700015 * THIS MACRO IS USED BY MFT PDAR MODULE FOR MCH. 03600021 SPACE 04500015 ********************************************************************* 05400015 * * 06300015 * 6/22/71 LEVEL 21 07200021 * * 08100015 ********************************************************************* 09000015 * * 09900015 ***** A S R C O M M U N I C A T I O N A R E A ***** 10800015 * * 11700015 DS 0D 12600015 IGFDCB EQU * ENTRY FOR 1ST LOAD MODULE 13500015 COMENVCK DC CL8'IGFASR0B' 1ST LOAD MODULE OF ASR 14400015 COMPDAR EQU * START PDAR AREA 15300015 PDARSTAT DC X'0' 16200015 PDARTCB DC 3X'0' 17100015 PDARTAB DC 9F'0' 18000015 PDARCUA DC 9F'0' 18900015 COMERXNT DC V(IEAASNT2) POINTER TO ERROR TRANSIENT AREA 19800015 IGFMOD EQU * 1ST BYTE OF NEXT FIELD IS CPU MODEL NUMBER 20700015 COMCVT DC V(IEACVT) ADDR OF CVT 21600015 COMCHASG DC V(IFBACTA) POINTER TO CHANNEL ASSIGNMENT MODU 22500015 IGFRES EQU * ADDRESS OF MFT RAM 23400015 COMRAM DC A(0) 24300015 IGFBLDL EQU * ADDRESS OF BLDL 25200015 COMBLDL DC A(0) 26100015 IGFSVBLD EQU * ADDRESS OF SVC BLDL SVBLD 26150021 COMSVBLD DC A(0) SVBLD 26200021 IGFSVCQ EQU * ADDRESS OF QUEUE 27000015 COMSVCQ DC A(0) OF RESIDENT 3 AND 4 SVCS 27900015 COMTRANS DC V(IEAAXSNT) MFT-NAME OF XSNT ROUTINE 28800015 COMSBAD DC F'0' ADDR OF FAILING STORAGE LOCATION 29100015 COMSIRB DC V(SIRB) SYSTEM SIRB POIMNTER 29400015 IGFNUC01 EQU * LIST OF REFRESHABLE NUCLEUS MODULES 29700015 DC D'0' 30600015 COMNUC DC 2D'0' NUCLEUS DATA 31500015 COMPSA DC 16D'0' PERMANENT STORAGE SAVE AREA 32400015 COMSYSRS DC F'0' SYSRES ADDR AND DEVICE TYPE 33300015 COMCNSL DC F'0' ACTIVE SYSTEM CONSOLE ADDR AND TYPE 34200015 COMIOQ DC F'0' POINTER TO I/O INTERRUPT SAVE QUEUE 35100015 COMPRNT DC F'0' ADDRESS OF CONSOLE PRINT ROUTINE 36000015 COMMSG0 DC 2D'0' CNSOLE RTN MESSAGE BUFFERS 36900015 COMMSG1 DC 2D'0' 37800015 COMEXADR DC F'0' EXECUTE INSTR ADDR FOR IRE 38700015 COMOBREX DC F'0' ADDRESS OF OBR EXIT ROUTINE 39100015 COMLEV0A DC X'0' THESE ARE MODULE CHANGE LEVEL FIELDS TO BE 39130015 COMLEV1A DC X'0' LAODED BY EACH MODULE AS EACH MODULE IS 39160015 COMLEV0B DC X'0' EXECUTED 39190015 COMLEV0C DC X'0' 39220015 COMLEV1C DC X'0' 39250015 COMLEV2C DC X'0' 39280015 COMLEV3C DC X'0' 39310015 COMLEV0D DC X'0' 39340015 COMLEV1D DC X'0' 39370015 COMLEV2D DC X'0' 39400015 COMLEV00 DC X'0' 39430015 COMLEV01 DC X'0' 39460015 COMLEV10 DC X'0' 39490015 COMLEV20 DC X'0' 39520015 * 39600015 * 40500015 ***** E X P A N S I O N A R E A * 41400015 * 42300015 COMSPARE DC 56X'0' 43200015 * * 44100015 ***** A S R R E C O R D E N T R Y B U I L D A R E A ***** 45000015 * * 45900015 CTFLDID DC XL5'0' COUNT FIELD 46800015 CTFLDKEY DC X'00' KEY LENGTH 47700015 CTFLDDL DC XL2'0000' DATA LENGTH FOR RECORD ENTRY 48600015 * 49500015 REKEY DC X'0000' RECORD ENTRY KEY 50400015 * 51300015 RELABEL DC 3X'0' LABEL 52200015 REFORMT DC X'0' RECORD ENTRY FORMAT TYPE 53100015 REMODNUM DC X'00' CPU MODEL 65 54000015 RETYPE DC X'0' TYPE OF ERROR 54900015 RECTLIND DC XL2'0000' EREP CONTROL INDICATORS 55800015 REDATE DC F'0' DATE OF RECORD 56700015 RETIME DC F'0' TIME OF RECORD 57600015 REPROGID DC D'0' ACTIVE PROGRAM ID 58500015 REMCOPSW DC D'0' MACHINE CHECK OLD PSW 59400015 REAIOU DC 4F'0' CH/UNIT ADR OF ACTIVE UNITS (MAX 8) 60300021 RECHASSG DC D'0' CHANNEL TYPE ASSIGNMENTS 61200021 REENVCHK DC 1D'0' ENVIRONMENT CHECK DATA 62100015 REROSCHK DC 3D'0' ROS CHECK DATA 63000015 REMEST DC 14D'0' MEMORY STATUS CHECKER DATA 63900015 REPDAR DC 3D'0' PROGRAM DAMAGE ASSESSMENT DATA 64800015 * 65700015 RERETRY EQU * INSTRUCTION RETRY DATA 66600015 ISUM1 DC 2X'0' TABLE 1 AREA 67500015 ISUMFAIL DC 6X'0' FAILING INSTRUCTION 68400015 ISUM2 DC 2X'0' TABLE 2 AREA 69300015 ISUMROS DC 2X'0' ROS ADDRESS 70200015 ISUMFADR DC F'0' FAILING INSTRUCTION ADDRESS 71100015 ISUMBAL DC F'0' ALT INSTR ADDR OR BAL 72000015 ISUMBAD DC F'0' BAD OPERAND ADDRESS 72900015 * 73800015 REGSGPR DC 8D'0' GPR CONTENTS 74700015 REGSFPR DC 4D'0' FPR CONTENTS 75600015 REGPARGP DC D'0' GPR PARITY INDICATORS 76500015 REGPARFP DC F'0' FPR PARITY INDICATORS 77400015 TEMPSPRE DC F'0' TEMPORARY SPARE TO INSURE DBLWRD 78300015 RECPULOG DC 22D'0' CPU HARDWARE LOGOUT AREA 79200015 * 80100015 ***** E X P A N S I O N A R E A F O R L O G O U T 81000015 * 81900015 RESPARE DC 80C'0' 82800015 * 83700015 * 84600015 ***** C H A N N E L I N B O A R D R E P O S I T I O N S ***** 85500015 * 86400015 * THESE POSITIONS ARE USED WHEN HANDLING A CHANNEL INBOARD ERROR, 87300015 * WITH MCH IN THE SYSTEM, BUT NO CCH. MCH FORMS AND RECORDS A SER- 88200021 * TYPE RECORD VIA ITS ERROR RECORDER MODULE. 89100015 SPACE 2 90000015 RECCW1 EQU RELABEL+24 FIRST CCW OF FAILING CHAIN 90900015 RECCW2 EQU RELABEL+32 FAILING CCW 91800015 RECSW EQU RELABEL+40 CHANNEL STATUS WORD 92700015 REACTIO EQU RELABEL+48 ACTIVE I/O UNITS 93600015 RECHASG EQU RELABEL+64 CHANNEL TYPE ASSIGNMENTS 94500021 RECUA EQU RELABEL+72 CHANNEL/UNIT ADDRESS 95400015 REIOLOG EQU RELABEL+76 I/O HARDWARE LOGOUT AREA 96300015 MEND 97200015 ./ ADD SSI=01011525,SOURCE=1,NAME=ATTNLEVL ATTNLEVL DSECT 03000000 ATTNFWPT DS 1F FORWARD PTR 06000000 ATTNBKPT DS 1F BACKWARD PTR 09000000 ATTNLVID DS 1F CONSTANT X'F2040000' 12000000 ATTNDERB DS 1F ADDRESS OF FIRST DIRECT ENTRY ROUTINE BLOCK 15000000 ATTNAVAL DS 1F ADDRESS OF FIRST AVAILABLE QUEUE ENTRY 18000000 ATTNDATA DS 1F ADDRESS OF LAST DE ATTENTION OCCURRENCE 21000000 ATTNMLEN DS 1F MAIN LINE DATA ENTRIES 24000000 ATTNFLGA DS BL1 ATTENTION LEVEL FLAGS A 27000000 * BIT 0-EOS XY OPTION 30000000 * BIT 1-EOS REGENERATE OPTION 33000000 * BIT 2-LP XY OPTION 36000000 * BIT 3-LP CHARACTER CODE OPTION 39000000 * BIT 4-LP REGENERATE OPTION 42000000 * BIT 5-DE DEQUEUE DATA OPTION 45000000 * BIT 6-DE ACTIVE/NOT ACTIVE 48000000 * BIT 7-DELAYED DIRECT ENTRY IN PROGRESS 51000000 ATTNFLGB DS BL1 ATTENTION LEVEL FLAGS B 54000000 * BIT 0-REQATN SEARCH 0=NO 1=YES 57000000 ATTNBPID DS BL1 BACK PTR INDICATOR 60000000 ATTNLITE DS BL1 PF INDICATOR LIGHTS OPTION 63000000 ATTNPFLM DS 1F PF INDICATOR LIGHTS MASK 66000000 ATTNPFEN DS 1F ENABLED PF KEYS FOR LEVEL 69000000 ATTNANEN DS 1F ENABLED A/N SOURCES FOR LEVEL 72000000 ATTNPFDE DS 1F ENABLED PF KEYS FOR DIRECT ENTRY 75000000 ATTNANDE DS 1F ENABLED A/N SOURCES FOR DIRECT ENTRY 78000000 ATTNAECB DS 1F ECB FOR ATTN SOURCE 99 81000000 ATTNSETA DS 3F SETATN DATA AREA 84000000 ATTNDECB DS 1F DELAYED DIRECT ENTRY ECB 87000000 ./ ADD SSI=01011928,SOURCE=1,NAME=BPX * %GO TO DCLBPX; /* 02000021 MACRO 04000021 &L BPX 06000021 .*A000000-999999 S21014 06050021 AIF ('&L' EQ '').BPXL 08000021 &L DSECT , BUFFER PREFIX 10000021 AGO .BPXN 12000021 .BPXL ANOP 14000021 BPX DSECT , BUFFER PREFIX 16000021 .BPXN ANOP 18000021 BPXLINK DS 0A FLAGS AND LINK FIELD 20000021 BPXFLGS DS XL1 BUFFER PREFIX FLAGS 22000021 BPXTYPE EQU 128+64 00=TRC, 01=SMG, 10=WTO 24000021 BPXFULL EQU 32 BUFFER FULL 26000021 BPXSCED EQU 16 BUFFER SCHEDULED 28000021 BPXCURR EQU 8 CURRENT BUFFER INDICATION 30000021 BPXLINKA DS AL3 PTR TO NEXT BPX IN POOL 32000021 BPXDECB DS A PTR TO DECB, IF SCHEDULED 34000021 BPXBUFF DS 0C OS VARIABLE BLOCKED RECORD 36000021 BPXPRLEN DS H PHYSICAL RECORD LENGTH 38000021 DS H BB FIELD 40000021 BPXLRLEN DS H LOGICAL RECORD LENGTH OF FIRST 42000021 MEND , */ 44000021 * %DCLBPX: ; 46000021 * DCL 1 BPX BASED, /* BUFFER & PREFIX */ 48000021 * 2 BPXLINK PTR(32), /* FLAGS AND LINK FIELD */ 50000021 * 3 BPXFLGS BIT(8), /* BUFFER PREFIX FLAGS */ 52000021 * 4 BPXTYPE BIT(2), /* 00=TRC BUFFER */ 54000021 * /* 01=MSG BUFFER */ 56000021 * /* 10=WTO BUFFER */ 58000021 * 4 BPXFULL BIT(1), /* FULL BIT */ 60000021 * 4 BPXSCED BIT(1), /* SCHEDULED BIT */ 62000021 * 4 BPXCURR BIT(1), /* CURRENT BIT */ 64000021 * 4 * BIT(3), /* RESERVED */ 66000021 * 3 BPXLINKA PTR(24), /* PTR NEXT BPX OF POOL */ 68000021 * 2 BPXDECB PTR(31), /* DECB ADDR, IF SCHED */ 70000021 * 2 BPXBUFF, /* OS VARIABLE-BLOCKD RD*/ 72000021 * 3 BPXPRLEN FIXED(15), /* PHYSICAL RCD LGTH */ 74000021 * 3 * CHAR(2), /* UNUSER */ 76000021 * 3 BPXLRECD, /* LOGICAL RECORD */ 78000021 * 4 BPXLRLEN FIXED(15); /* LOGICAL RCD LGTH */ 80000021 ./ ADD SSI=01012334,SOURCE=1,NAME=BRING MACRO 01000020 &NAME BRING &LOAD=,&CALL=,&DELETE=,&LIST=,&C= 02000020 LCLA &A,&B,&K,&L 03000020 LCLC &MOD,&MOD1 04000020 &B SETA &C+1 05000020 &L SETA 0 06000020 &A SETA &C/8*128 07000020 AIF (T'&LOAD NE 'O').LD1 08000020 AIF (T'&CALL NE 'O').CL1 09000020 AIF (T'&DELETE NE 'O').DE1 10000020 MNOTE 8,'KEYWORD LOAD, CALL, OR DELETE MISSING' 11000020 MEXIT 12000020 .LD1 ANOP 13000020 &A SETA &A+32 14000020 &MOD SETC '&LOAD' 15000020 &K SETA K'&LOAD 16000020 AIF (&K LT &B).OK 17000020 &L SETA &K-&C 18000020 &MOD1 SETC '&LOAD'(&B,&L) 19000020 AGO .OK 20000020 .CL1 ANOP 21000020 &MOD SETC '&CALL' 22000020 &K SETA K'&CALL 23000020 AIF (&K LT &B).OK 24000020 &L SETA &K-&C 25000020 &MOD1 SETC '&CALL'(&B,&L) 26000020 AGO .OK 27000020 .DE1 ANOP 28000020 &A SETA &A+16 29000020 &MOD SETC '&DELETE' 30000020 &K SETA K'&DELETE 31000020 AIF (&K LT &B).OK 32000020 &L SETA &K-&C 33000020 &MOD1 SETC '&DELETE'(&B,&L) 34000020 .OK AIF (&L EQ 0).OKA 35000020 AIF ('&MOD'(1,1) EQ '(' OR '&MOD'(1,1) EQ '''').OKA1 36000020 AIF (&K LT 9).OKA 37000020 .ER1A ANOP 38000020 &MOD SETC '&MOD'(1,&C) 39000020 .ER1B MNOTE 8,'TOO MANY CHARACTERS IN &MOD&MOD1' 40000020 MEXIT 41000020 .OKA1 AIF (&L LT 3).OKA 42000020 &MOD SETC '&MOD'(2,&C-1) 43000020 &MOD1 SETC '&MOD1'(1,&L-1) 44000020 AGO .ER1B 45000020 .OKA ANOP 46000020 &NAME DS 0H 47000020 AIF (T'&LIST EQ 'O').SKP1 48000020 AIF ('&LIST'(1,1) NE '(').SKP1 49000020 ST &LIST.,L&SYSNDX . STORE LIST ADDRESS 50000020 .SKP1 AIF ('&MOD'(1,1) NE '(').SKP2 51000020 MVC P&SYSNDX.+2(&C),0&MOD . NAME INTO PARAMETER LIST 52000020 AGO .SKP3 53000020 .SKP2 AIF ('&MOD'(1,1) EQ '''').SKP3 54000020 MVC P&SYSNDX.+2(&C),&MOD . NAME INTO PARAMETER LIST 55000020 .SKP3 ANOP 56000020 LA R14,R&SYSNDX . 57000020 L R15,TAB28 . TRANSIENT MANAGER ENTRY POINT 58000020 CNOP 2,4 . 59000020 BALR R1,R15 . 60000020 P&SYSNDX DC AL1(&A) . INDICATORS FOR TRANSIENT MANAGER 61000020 DC AL1(2) . MACRO LEVEL 62000020 AIF ('&MOD'(1,1) EQ '''').SKP4 63000020 DC CL&C.' ' . MODULE 64000020 AGO .SKP5 65000020 .SKP4 AIF (&L EQ 0).SKP4A 66000020 &MOD SETC '&MOD'(1,&C) 67000020 DC CL&C&MOD&MOD1 . MODULE NAME 68000020 AGO .SKP5 69000020 .SKP4A ANOP 70000020 DC CL&C&MOD . MODULE NAME 71000020 .SKP5 ANOP 72000020 AIF (T'&LIST EQ 'O').SKP3A 73000020 L&SYSNDX DC A(&LIST) . 74000020 .SKP3A ANOP 75000020 R&SYSNDX DS 0H . RETURN ADDRESS 76000020 MEND 77000020 ./ ADD SSI=01012727,SOURCE=1,NAME=BRKELEM MACRO 03000000 BRKELEM 06000000 BRKELEM DSECT 09000000 SPACE 12000000 * FIELDS WITHIN A BREAK ELEMENT 15000000 SPACE 18000000 BRKLINK DS A POINTER TO NEXT BREAK ELEMENT. 21000000 BRKADDR DS F PROBLEM PROGRAM INSTRUCTION ADDRESS. 24000000 BRKINST DS 2F ORIGINAL INSTRUCTION AND 2 BYTE SVC. 27000000 BRKFLGS DS 1X ONE BYTE FOR FLAGS. 30000000 BALSW EQU B'10000000' BAL OR BALR IN ORIGINAL INSTRUCTION. 33000000 BRKRANGE EQU B'01000000' THIS BREAK ELEMENT IS ONE OF A RANGE. 36000000 BRKLIST EQU B'00100000' THIS BREAK ELEMENT IS ONE OF A LIST. 39000000 BRKNONOT EQU B'00010000' USER IS NOT TO BE NOTIFIED IF THIS 42000000 * BREAKPOINT IS ENCOUNTERED. 45000000 DS X RESERVED. 48000000 BRKDISP DS 2X DISPLACEMENT FROM FIRST ADDRESS OF 51000000 * A RANGE. 54000000 BRKNAME DS A POINTER TO THE ADDRESS STRING. 57000000 BRKCHAIN DS A POINTER TO THE SUB-COMMAND CHAIN. 60000000 BRKCOUNT DS F COUNT INFORMATION. 63000000 BRKRB DS A POINTER TO PROBLEM PROGRAM RB. 66000000 DS 0D FORCE LENGTH EQUATE TO DOUBLE WORD. 69000000 BRKLEN EQU *-BRKELEM BREAK ELEMENT LENGTH. 72000000 BRKFLGS1 EQU BRKADDR+3 INACTIVE BREAKPOINT FLAG FIELD. 75000000 BRKINACT EQU B'00000001' INACTIVE BREAKPOINT FLAG. 78000000 MEND 81000000 ./ ADD SSI=01012034,SOURCE=1,NAME=BRPRTMSG MACRO 00050021 &NAME BRPRTMSG &ADDR,&LN 00100021 AIF ('&LN'(1,1) EQ '(').LN1 00150021 &NAME LA R2,&LN LOAD LENGTH TO R2 00200021 AGO .LN2 00250021 .LN1 AIF ('&LN'(2,2) EQ 'R2').LN3 00300021 &NAME LR R2,&LN LOAD LENGTH TO R2 00350021 AGO .LN2 00400021 .LN3 ANOP 00450021 &NAME DS 0H 00500021 .LN2 AIF ('&ADDR' EQ '').LOAD 00550021 AIF ('&ADDR'(1,1) EQ '(').ADDR2 00600021 LA R1,&ADDR LOAD ADDR TO R1 00650021 AGO .LOAD 00700021 .ADDR2 AIF ('&ADDR'(2,2) EQ 'R1').LOAD 00750021 LR R1,&ADDR(1) LOAD ADDR TO R1 00800021 .LOAD ANOP 00850021 L R15,APRTMSG LOAD ADDR OF PRTMSG 00900021 BALR RETREG,R15 LINK TO IT 00950021 MEND 01000021 ./ ADD SSI=01013522,SOURCE=1,NAME=BRREAD MACRO 01000020 &LABEL BRREAD ®,&TYPE,&TJID= 02000020 .*** GLOBAL VARIABLE &PLIST CONTROL GENERATION OF PARMETER LIST *** 03000020 GBLB &PARMLST 04000020 GBLC &PLIST 05000020 LCLC &TLAB 06000020 .*** TEST FOR P-REG *** 07000020 AIF ('®' NE '').OK1 08000020 MNOTE 12,'MISSIMG ADDR REG' 09000020 MEXIT 10000020 .OK1 ANOP 11000020 .*** TEST FOR DEMAND P-LIST *** 12000020 AIF (&PARMLST).EXTGEN 13000020 .*** TEST FOR FIRST CALL OF BRREAD IN THIS CSECT *** 14000020 AIF ('&PLIST' EQ 'RDL'.'&SYSECT'(4,5)).NOLIST 15000020 .*** IF FIRST CALL GENERATE PARAMETER LIST *** 16000020 &PLIST SETC 'RDL'.'&SYSECT'(4,5) 17000020 AGO .NOEXTGN 18000020 .EXTGEN ANOP 19000020 &PLIST SETC 'TMP'.'&SYSNDX' 20000020 .NOEXTGN ANOP 21000020 CNOP 0,4 ALLIGN ON WORD BOUNDARY 22000020 &LABEL ST ®(1),&PLIST STORE ADDRESS OF STORAGE REQUIRED 23000020 .ST11 ANOP 24000020 .*** GENERATE STORE OF REQUESTED ADDRESS BEFORE POINT TO P-LIST *** 25000020 &TLAB SETC 'RDL'.'&SYSNDX' 26000020 BAL 1,&TLAB POINT TO PARAMETER LIST 27000020 &PLIST DS F ADDRESS OF STORAGE REQUIRED 28000020 DS H TJID OF THIS STORAGE 29000020 DS C FUNCTION CODE FOR READ ROUTINE 30000020 DS C RESERVED 31000020 &TLAB EQU * 32000020 AGO .TESTID 33000020 .NOLIST ANOP 34000020 &LABEL ST ®(1),&PLIST STORE ADDRESS OF STORAGE REQUIRED 35000020 .ST12 ANOP 36000020 LA 1,&PLIST POINT TO PARAMETER LIST 37000020 .TESTID ANOP 38000020 .*** IF TJID IS NOT SPECIFIED, LEAVE PARAMETER LIST AS IS *** 39000020 AIF ('&TJID' EQ '').TSTTYPE 40000020 .*** DISTINGUISH BETWEEN TJID REG AND TJID ABSOLUTE NUMBER *** 41000020 AIF ('&TJID'(1,1) EQ '(').REG 42000020 AIF ('&TJID' EQ '0').GENSR 43000020 MVC &PLIST+4(2),&TJID . GET VALUE OF TJID FROM STORAGE 44000020 AGO .TSTTYPE 45000020 .GENSR ANOP 46000020 SR 15,15 47000020 .STORID ANOP 48000020 STH 15,&PLIST+4 STORE TJID IN PARAMETER LIST 49000020 AGO .TSTTYPE 50000020 .REG ANOP 51000020 STH &TJID(1),&PLIST+4 STORE TJID IN PARAMETER LIST 52000020 .TSTTYPE AIF ('&TYPE' EQ 'INIT').SETINIT 53000020 AIF ('&TYPE' EQ 'ADJUST').SETFREE 54000020 AIF ('&TYPE' EQ 'DATA' OR '&TYPE' EQ '').SETDATA 55000020 MNOTE 12,'INVALID READ FUNCTION' 56000020 MEXIT 57000020 .SETINIT ANOP 58000020 LA 15,4 FUNCTION CODE FOR INITIALIZATION 59000020 AGO .STORE 60000020 .SETFREE ANOP 61000020 LA 15,8 FUNCTION CODE TO INDICATE 62000020 * RELEASE READ SWAP ROUTINE 63000020 .STORE ANOP 64000020 STC 15,&PLIST+6 STORE FUNCTION CODE IN 65000020 * PARAMETER LIST 66000020 AGO .CALL 67000020 .SETDATA ANOP 68000020 XC &PLIST+6(1),&PLIST+6 ZERO FUNCTION CODE TO INDICATE 69000020 * DATA REQUIRED 70000020 .CALL ANOP 71000020 L 15,READADDR FETCH READ ROUTINE ADDRESS FROM 72000020 * COMMON CSECT 73000020 BALR 14,15 LINK TO READ 74000020 AIF (NOT(&PARMLST)).OUT 75000020 &PLIST SETC 'RDL'.'&SYSECT'(4,5) 76000020 &PARMLST SETB 0 77000020 .OUT ANOP 78000020 MEND 79000020 ./ ADD SSI=21260090,NAME=BRWRITE,SOURCE=0 MACRO 07000020 &NAME BRWRITE &PARM,&MODE S21014 14000000 LCLA &IMCT S21014 14050000 AIF ('&MODE' EQ '').AFOP S21014 14100000 AIF ('&MODE' EQ 'AFT').AFOP S21014 14150000 AIF ('&MODE' EQ 'IMM').IMOP S21014 14200000 .* S21014 14210000 MNOTE 12,'INVALID BRWRITE MODE - MUST BE ''IMM'' OR ''AFT''' 14250000 MEXIT 14300000 .IMOP ANOP S21014 14350000 AIF ('&PARM' NE 'SKIP').IMLINE S21014 14400000 &NAME LA PREG,2 . SET CODE FOR SKIP IMMEDIATELY S21014 14450000 AGO .COMPL S21014 14500000 .IMLINE ANOP S21014 14550000 &IMCT SETA &PARM S21014 14600000 &IMCT SETA &IMCT+2 S21014 14650000 &NAME LA PREG,&IMCT . SET SPACE IMMED. CODE S21014 14700000 AGO .COMPL S21014 14750000 .AFOP ANOP S21014 14800000 AIF ('&PARM' EQ 'SKIP').NEXT 21000020 &NAME LA PREG,&PARM . LOAD PARM FOR NUMB OF SPACES 28000000 AGO .NEXT1 35000020 .NEXT ANOP 42000020 &NAME LA PREG,1 . INDICATE SKIP TO 49000000 .COMPL ANOP S21014 49050000 LCR PREG,PREG . COMPLEMENT TO INDICATE S21014 56000000 * IMMEDIATE OPERATION OR SKIP S21014 56050000 .NEXT1 ANOP 63000020 L R15,AWRITE . LOAD ADDR OF WRITE ROUTINE 70000000 BALR RETREG,R15 . LINK TO IT 77000000 MEND 84000020 ./ ADD SSI=01030060,SOURCE=1,NAME=BUFDEF MACRO 09000000 &BUF BUFDEF &PB,&LB,&KEY,&TEXT 18000000 AF&BUF.FW DS 0CL10 . ORIGIN OF BUFFER DEFINING CONSTANTS 27000000 DC Y(&PB) . LENGTH OF PHYSICAL BUF. (BLKSIZFW) 36000000 DC Y(&LB) . LENGTH OF LOGICAL BUF. (ULLRECFW) 45000000 DC Y(&KEY) . KEY POSITION (UADKEYFW) 54000000 DC Y(&TEXT-&KEY) . TEXT - KEY POSITION (UADDATFW) 63000000 DC Y(&LB+&KEY-&TEXT) .NEXT KEY - TEXT POSITION (UADNKYFW) 72000000 MEND 81000000 ./ ADD SSI=01030060,SOURCE=1,NAME=BUFFERDS MACRO 05000000 BUFFERDS 10000000 BUFFERDS DSECT 15000000 BUFFERSS DS 0CL112 . TOTAL BUFFER AREA LENGTH 20000000 USING *,ISMBUFRG 25000000 BUFFER EQU BUFFERSS 30000000 CONTRLSS DS 2F . CONTROL WORDS 35000000 BUFOUTSS DS 0CL104 . BUFFER LENGTH 40000000 DCIRCSS DS CL1 . PLACE FOR CIRCLE D 45000000 LINOUTSS DS 0CL103 . OUTPUT LINE NO. AND DATA 50000000 LINNOSS DS CL8 . LINE NUMBER AREA 55000000 BLANK DS CL1 60000000 DATOUTSS DS 0CL80 . DATA AREA 65000000 PADSS DS CL6 . SPACE 70000000 DATASS DS CL88 . AREA FOR INPUT DATA 75000000 MEND 80000000 ./ ADD SSI=01011728,SOURCE=1,NAME=BUILDS MACRO 03000000 &NAME BUILDS &BUFLIST,&NUMSIZE 06000000 AIF ('&BUFLIST' NE '(1)' OR '&NUMSIZE' NE '(0)').NOGOOD 09000000 &NAME STM RC,RE,12(RN) SAVE REGS 12000000 L RC,0(0,RB) FIRST BUFFER ADDRESS-8 15000000 LR RD,RA MOVE # OF BUFFERS AND LENGTH TO RD 18000000 LA RD,3(0,RD) UP IT BY 3 21000000 ST RD,4(0,RC) STORE IN FIRST BUFFER-4 24000000 NI 7(RC),X'FC' ROUND LENGTH TO FULL WORD 27000000 LA RE,8(0,RC) RE POINTS TO ACTUAL BUFFER 30000000 ST RE,0(0,RC) STORE BUFFER ADDRESS IN 8 BYTE CONT. 33000000 SRL RD,16 POSITION # OF BUFFERS 36000000 BLDCONT BCT RD,BLDLOOP ARE WE DONE 39000000 B BUILDEND YES 42000000 BLDLOOP LA RB,4(0,RB) NO - UP POINTER TO PARAMETER LIST 45000000 L RC,0(0,RB) GET ADDRESS OF NEXT BUFFER 48000000 ST RC,0(0,RE) LINK BUFFERS 51000000 LR RE,RC KEEP ADDRESS OF NEW BUFFER 54000000 B BLDCONT CONTINUE BUILDING 57000000 BUILDEND SR RC,RC 60000000 ST RC,0(0,RE) PUT ZERO'S IN LAST LINK LOCATION 63000000 LM RC,RE,12(RN) RESTORE REGISTERS 66000000 MEXIT 69000000 .NOGOOD MNOTE 'OPERAND OF BUILDS MACRO MUST BE ''(1),80)''' 72000000 MEND 75000000 ./ ADD SSI=01030060,SOURCE=1,NAME=CCWMSK MACRO 04000000 CCWMSK &ITER 08000000 LCLA &A 12000000 .* EACH DOUBLE WORD OF THE DSECT DESCRIBES A CCW. NORMALLY CCWRG 16000000 .* HAS THE ADDRESS OF CCWADDR0. THE SINGLE MACRO ARGUMENT, &ITER, 20000000 .* THE HIGHEST ITERATION DESIRED. THUS CCWMSK 3 WILL GENERATE 24000000 .* ITERATIONS BEGINNING CCWADDR0, CCWADDR1, CCWADDR2, CCWADDR3. 28000000 CCWMSK DSECT 32000000 .BEGIN ANOP 36000000 CCWADDR&A DS 0F 40000000 CCWCMCD&A DS X 44000000 DS 3C 48000000 CCWFCNT&A DS 0F 52000000 CCWFLGS&A DS X 56000000 DS X 60000000 CCWHCNT&A DS 0H 64000000 DS X 68000000 CCWCNT&A DS X 72000000 &A SETA &A+1 76000000 SPACE 80000000 AIF (&A LE &ITER).BEGIN 84000000 MEND 88000000 ./ ADD SSI=01012176,SOURCE=1,NAME=CECOM MACRO 00400000 &NAME CECOM &OUTMSG=,&INMSG=,&OUTSD=,&FREE=,&POLL=,&MF= 00800000 .* 01200000 .* MACRO NAME: CECOM 01600000 .* 02000000 .* STATUS: CHANGE LEVEL 001 02400000 .* 02800000 .* FUNCTION: THE CECOM MACRO PROVIDES A COMMUNICATION LINK BETWEEN 03200000 .* THE OLT TEST SECTION AND THE CE. THERE ARE BASICALLY 03600000 .* 5 FUNCTIONS DEFINABLE UNDER THIS MACRO; 04000000 .* 04400000 .* 1. THE OLT TEST SECTION WILL OUTPUT A MESSAGE TO THE 04800000 .* CE AND WAIT FOR THE RETURN OF HIS INPUT RESPONSE. 05200000 .* 05600000 .* 2. THE OLT TEST SECTION CAN OUTPUT A MESSAGE TO THE 06000000 .* CE ONLY AND NOT PROVIDE FOR A RESPONSE. 06400000 .* 06800000 .* 3. THE OLT TEST SECTION CAN OUTPUT A MESSAGE TO THE 07200000 .* CE WITH AN INPUT RESPONSE PROVIDED FOR BUT NOT 07600000 .* WAIT FOR IT. THE CE MAY RESPOND AT A LATER TIME 08000000 .* AND THE OLT WILL CONTINUE TESTING. 08400000 .* 08800000 .* 4. THE OLT TEST SECTION CAN TEST TO SEE IF THE 09200000 .* DELAYED RESPONSE IN ITEM 3 HAS OCCURRED YET. 09600000 .* 10000000 .* 5. THE OLT TEST SECTION CAN CANCEL OR FREE THE 10400000 .* DELAYED RESPONSE IN ITEM 3 IF IT HAS NOT 10800000 .* OCCURRED YET. 11200000 .* 11600000 .* REGISTER 15 RETURN CODE: 12000000 .* 12400000 .* THE RETURN CODES HAVE DIFFERENT MEANINGS DEPENDING ON 12800000 .* THE 5 FUNCTIONS DESCRIBED ABOVE; 13200000 .* 13600000 .* CODE FUNCTION MEANING 14000000 .* 14400000 .* 00 1. THE MESSAGE HAS BEEN OUTPUTED AND 14800000 .* THE CE RESPONSE HAS BEEN RECEIVED. 15200000 .* 15600000 .* 2. THE MESSAGE HAS BEEN OUTPUTED. 16000000 .* 16400000 .* 3. THE MESSAGE HAS BEEN OUTPUTED. 16800000 .* 17200000 .* 4. THE DELAYED RESPONSE HAS BEEN 17600000 .* RECEIVED. 18000000 .* 18400000 .* 5. THE DELAYED RESPONSE HAS BEEN 18800000 .* CANCELLED. 19200000 .* 19600000 .* 04 ALL THE FACILITY IS NOT AVAILABLE. 20000000 .* 20400000 .* 08 ALL AN ERROR HAS OCCURRED DURING THE 20800000 .* OUTPUT OR INPUT MESSAGE. 21200000 .* 21600000 .* 0C 4 THE DELAYED RESPONSE HAS NOT BEEN 22000000 .* RECEIVED YET. 22400000 .* 22800000 .* 10 3 THERE IS AN OUTSTANDING DELAYED 23200000 .* RESPONSE THAT MUST BE RECEIVED OR 23600000 .* CANCELLED BEFORE A NEW DELAYED 24000000 .* RESPONSE CAN BE ISSUED. 24400000 .* 24800000 .* PARAMETERS AND/OR KEYWORDS: 25200000 .* 25600000 .* OUTMSG= - DEFINES THE MESSAGE TO BE PUT OUT FROM THE 26000000 .* OLT TEST SECTION TO THE CE. 26400000 .* 26800000 .* ADDR - ADDRESS OF THE MESSAGE. 27200000 .* 27600000 .* INTEGER - NUMBER OF BYTES IN THE MESSAGE 28000000 .* THAT IS NOT TO EXCEED 51. 28400000 .* 28800000 .* INMSG= - DEFINES THE CE RESPONSE REQUIREMENTS. 29200000 .* 29600000 .* ADDR - ADDRESS WHERE THE REPLY IS TO BE 30000000 .* INSERTED. 30400000 .* 30800000 .* INTEGER - MAXIMUM NUMBER OF BYTES ACCEPTABLE 31200000 .* IN THE REPLY. (SIZE OF THE REPLY 31600000 .* BUFFER). 32000000 .* 32400000 .* OUTSD=YES - DEFINES THE 2 WAY COMMUNICATION BETWEEN 32800000 .* OLT TEST AND CE WITH THE DELAY RESPONSE. 33200000 .* 33600000 .* POLL=YES - DEFINES A REQUEST FOR CHECKING TO SEE IF 34000000 .* THE OUTSTANDING DELAYED RESPONSE HAS 34400000 .* OCCURRED YET. 34800000 .* 35200000 .* FREE=YES - DEFINES THE CANCELLATION OR FREEING OF 35600000 .* THE DELAYED RESPONSE. 36000000 .* 36400000 .* GLOBALS SET OR RESET BY THIS MACRO: NONE 36800000 .* 37200000 .* GLOBALS EXAMINED BY THIS MACRO: NONE 37600000 .* 38000000 .* SYMBOLS GENERATED BY THIS MACRO: NONE 38400000 .* 38800000 .* MNOTES ISSUED BY THIS MACRO: 39200000 .* 39600000 .* 8,'INVALID REG IN MF OPERAND' 40000000 .* 40400000 .* 8,'OUTSD WITHOUT BOTH OUTMSG AND INMSG INVALID' 40800000 .* 41200000 .* 8,'INMSG WITHOUT OUTMSG INVALID' 41600000 .* 42000000 .* 8,'NO OUTMSG OPERAND' 42400000 .* 42800000 .* 8,'INVALID OUTMSG PARAMETER' 43200000 .* 43600000 .* 8,'INVALID INMSG OPERAND' 44000000 .* 44400000 .* 8,'FREE OR POLL OPERAND MUST BE ALONE' 44800000 .* 45200000 .* 8,'OUTMSG INTEGER VALUE EXCEEDS MAXIMUM' 45600000 .* 46000000 .* REASONS: THE ABOVE MNOTES ARE SELF EXPLANATORY. 46400000 .* 46800000 .* EXAMPLE: 47200000 .* 47600000 .* ******************************************************************** 48000000 .* * NAME * OPERATION * OPERAND * 48400000 .* ******************************************************************** 48800000 .* * * * * 49200000 .* * METLK * CECOM * OUTMSG=(ADDR,INTEGER) * 49600000 .* * WETLK * CECOM * OUTMSG=(ADDR,INTEGER),INMSG=(ADDR,INTEGER) * 50000000 .* * TLKLTE * CECOM * OUTMSG=(ADDR,INTG),INMSG=(ADDR,INTG), * 50400000 .* * * * OUTSD=YES * 50800000 .* * NOTLK * CECOM * FREE=YES * 51200000 .* * DIDTLK * CECOM * POLL=YES * 51600000 .* * * * 52000000 .* 52400000 LCLA &A 52800000 AIF ('&MF(1)' EQ 'E').E 53200000 AIF (T'&FREE NE 'O').FREE 53600000 AIF (T'&POLL NE 'O').POLL 54000000 AIF (T'&OUTMSG EQ 'O').ERR1 54400000 AIF (N'&OUTMSG EQ 1).ERR2 54800000 .* AIF (&OUTMSG(2) GT 58).ERR5 55200000 AIF (T'&MF EQ 'O').STD 55600000 AIF ('&MF(1)' EQ 'L').LST 56000000 AGO .STD 56400000 .E ANOP 56800000 &NAME L R15,#TABLE . TABLE OF ENTRY ADDRESSES 57200000 L R15,28(R15) . ENTRY TO TRANSIENT MANAGER 57600000 AIF ('&MF(2)' EQ '(1)').E1 58000000 AIF ('&MF'(4,1) EQ '(').E12A 58400000 AIF (N'&MF EQ 1).E1 58800000 LA R1,&MF(2) . ADDRESS OF PARAMETER LIST 59200000 .E1 ANOP 59600000 BALR R14,R15 60000000 AGO .MEND 60400000 .E12A MNOTE 8,'INVALID REG IN MF OPERAND' 60800000 MEXIT 61200000 .STD ANOP 61600000 &NAME L R15,#TABLE . TABLE OF ENTRY POINT ADDRESSES 62000000 L R15,28(R15) . ENTRY TO TRANSIENT MANAGER 62400000 LA R14,R&SYSNDX . RETURN ADDRESS 62800000 CNOP 2,4 , ALIGN 63200000 BALR R1,R15 63600000 DC A(P&SYSNDX) . PARAMETER LIST FOR TRANSIENT MANAGER 64000000 AGO .N03 64400000 .LST ANOP 64800000 &NAME DC A(P&SYSNDX) . PARAMETER LIST FOR TRANSIENT MANAGER 65200000 AGO .N03 65600000 .FREE ANOP 66000000 AIF (T'&OUTMSG NE 'O' AND T'&INMSG NE 'O').ERR4 66400000 AIF (T'&POLL NE 'O' AND T'&OUTSD NE 'O').ERR4 66800000 &A SETA 64 67200000 AIF ('&MF(1)' EQ 'L').LST 67600000 AGO .STD 68000000 .POLL ANOP 68400000 AIF (T'&OUTMSG NE 'O' AND T'&INMSG NE 'O').ERR4 68800000 AIF (T'&POLL NE 'O' AND T'&OUTSD NE 'O').ERR4 69200000 &A SETA 32 69600000 AIF ('&MF(1)' EQ 'L').LST 70000000 AGO .STD 70400000 .N03 ANOP 70800000 AIF (T'&OUTSD EQ 'O').N04 71200000 AIF (T'&OUTMSG NE 'O' AND T'&INMSG NE 'O').N05 71600000 MNOTE 8,'OUTSD WITHOUT BOTH OUTMSG AND INMSG INVALID' 72000000 MEXIT 72400000 .N05 ANOP 72800000 &A SETA 128 73200000 .N04 ANOP 73600000 DC A(O&SYSNDX) . POINTER TO OUTMSG AND COUNT 74000000 DC A(I&SYSNDX) . POINTER TO INMSG AND COUNT 74400000 DC A(F&SYSNDX) . POINTER TO FLAGS 74800000 AIF (T'&OUTMSG NE 'O').N06 75200000 O&SYSNDX DC A(0) 75600000 DC A(0) 76000000 AGO .N06A 76400000 .N06 ANOP 76800000 O&SYSNDX DC A(&OUTMSG(1)) . OUTMSG ADDRESS 77200000 DC A(&OUTMSG(2)) . OUTMSG COUNT 77600000 .N06A ANOP 78000000 AIF (T'&INMSG NE 'O').N07 78400000 I&SYSNDX DC A(0) 78800000 DC A(0) 79200000 AGO .N09 79600000 .N07 ANOP 80000000 AIF (T'&OUTMSG EQ 'O').N08 80400000 I&SYSNDX DC A(&INMSG(1)) . INMSG ADDRESS 80800000 AIF (N'&INMSG EQ 1).ERR3 81200000 DC A(&INMSG(2)) . INMSG COUNT 81600000 AGO .N09 82000000 .N08 ANOP 82400000 I&SYSNDX DC A(0) 82800000 MNOTE 8,'INMSG WITHOUT OUTMSG INVALID' 83200000 MEXIT 83600000 .N09 ANOP 84000000 F&SYSNDX DC AL1(&A) . FLAGS 84400000 P&SYSNDX DC B'00000000' . INDICATORS FOR TRANSIENT MANAGER 84800000 DC AL1(1) . MACRO LEVEL 85200000 DC CL2'37' MACRO ID 85600000 R&SYSNDX DS 0H 86000000 MEXIT 86400000 .ERR1 MNOTE 8,'NO OUTMSG OPERAND' 86800000 MEXIT 87200000 .ERR2 MNOTE 8,'INVALID OUTMSG PARAMETER' 87600000 MEXIT 88000000 .ERR3 ANOP 88400000 MNOTE 8,'INVALID INMSG OPERAND' 88800000 MEXIT 89200000 .ERR4 ANOP 89600000 MNOTE 8,'FREE OR POLL OPERAND MUST BE ALONE' 90000000 MEXIT 90400000 .ERR5 ANOP 90800000 MNOTE 8,'OUTMSG INTEGER VALUE EXCEEDS MAXIMUM' 91200000 MEXIT 91600000 .MEND ANOP 92000000 MEND 92400000 ./ ADD SSI=01012321,SOURCE=1,NAME=CENXTR MACRO 10000020 &NAME CENXTR 20000020 &NAME IFDMOD LOAD='46' 30000020 MEND 40000020 ./ ADD SSI=01012811,SOURCE=1,NAME=CIBYFT MACRO 01000020 CIBYFT &NEXT= 02000020 LCLA &EBA 03000020 .*( 03200020 *2811 03400020 .*) 03600020 &EBA SETA N'&NEXT 04000020 AIF (&EBA LT 2).EB001 05000020 CIBYMV PRM=(&NEXT(1),&NEXT(2),&NEXT(3)),FTC=EB001 06000020 AIF (&EBA LT 5).EB002 07000020 CIBYMV PRM=(&NEXT(4),&NEXT(5),&NEXT(6)),FTC=EB002 08000020 AIF (&EBA LT 8).EB003 09000020 CIBYMV PRM=(&NEXT(7),&NEXT(8),&NEXT(9)),FTC=EB003 10000020 AIF (&EBA LT 11).EB004 11000020 CIBYMV PRM=(&NEXT(10),&NEXT(11),&NEXT(12)),FTC=EB004 12000020 AIF (&EBA LT 14).EB005 13000020 CIBYMV PRM=(&NEXT(13),&NEXT(14),&NEXT(15)),FTC=EB005 14000020 AGO .EB006 15000020 .* IMPLEMENTED FOR UP TO 5 CONSEC PHASES, CAN BE EXPANDED. 16000020 .EB006 ANOP 17000020 EB006 L CR13,CRSAVE+4 RESTORE REG 13 18000020 L CR14,12(CR13) RESTORE REG 14 19000020 LM CR0,CR12,20(CR13) RESTORE REGS 0 THRU 12 20000020 SVC 7 EXIT PHASE 21000020 CPHN16 DC CL8'IEP&NEXT(16).00' 22000020 DC A(CPHN16) 23000020 DC A(0) 24000020 .EB005 ANOP 25000020 EB005 L CR13,CRSAVE+4 RESTORE REG 13 26000020 L CR14,12(CR13) RESTORE REG 14 27000020 LM CR0,CR12,20(CR13) RESTORE REGS 0 THRU 12 28000020 SVC 7 EXIT PHASE 29000020 CPHN13 DC CL8'IEP&NEXT(13).00' 30000020 DC A(CPHN13) 31000020 DC A(0) 32000020 .EB004 ANOP 33000020 EB004 L CR13,CRSAVE+4 RESTORE REG 13 34000020 L CR14,12(CR13) RESTORE REG 14 35000020 LM CR0,CR12,20(CR13) RESTORE REGS 0 THRU 12 36000020 SVC 7 EXIT PHASE 37000020 CPHN10 DC CL8'IEP&NEXT(10).00' 38000020 DC A(CPHN10) 39000020 DC A(0) 40000020 .EB003 ANOP 41000020 EB003 L CR13,CRSAVE+4 RESTORE REG 13 42000020 L CR14,12(CR13) RESTORE REG 14 43000020 LM CR0,CR12,20(CR13) RESTORE REGS 0 THRU 12 44000020 SVC 7 EXIT PHASE 45000020 CPHN07 DC CL8'IEP&NEXT(07).00' 46000020 DC A(CPHN07) 47000020 DC A(0) 48000020 .EB002 ANOP 49000020 EB002 L CR13,CRSAVE+4 RESTORE REG 13 50000020 LA CR15,CPHAD4 LOAD ADDRESS OF NEXT PHASE 51000020 L CR14,12(CR13) RESTORE REG 14 52000020 LM CR0,CR12,20(CR13) RESTORE REGS 0 THRU 12 53000020 SVC 7 EXIT PHASE 54000020 CPHN04 DC CL8'IEP&NEXT(01).00' 55000020 CPHAD4 DC A(CPHN04) 56000020 DC A(0) 57000020 .EB001 ANOP 58000020 EB001 L CR13,CRSAVE+4 RESTORE REG 13 59000020 LA CR15,CPHAD1 LOAD ADDRESS OF NEXT PHASE 60000020 L CR14,12(CR13) RESTORE REG 14 61000020 LM CR0,CR12,20(CR13) RESTORE REGS 0 THRU 12 62000020 SVC 7 EXIT PHASE 63000020 AIF (&EBA EQ 1).EB007 64000020 CPHN01 DC CL8'IEP&NEXT(04).00' 65000020 .EB008 ANOP 66000020 CPHAD1 DC A(CPHN01) 67000020 DC A(0) 68000020 AGO .EB999 69000020 .EB007 ANOP 70000020 CPHN01 DC CL8'IEP&NEXT(01).00' 71000020 AGO .EB008 72000020 .EB999 ANOP 73000020 MEND 74000020 ./ ADD SSI=01012810,SOURCE=1,NAME=CIBYMV MACRO 02000020 CIBYMV &PRM=,&FTC= 04000020 LCLA &EBDPL,&EBIR0,&EBBIT 06000020 LCLB &EBIR1,&EBIR2,&EBIR3,&EBIR4,&EBIR5,&EBIR6,&EBIR7 08000020 .* CIBYMV SUPPORTS CIBYFT TO GEN TEST & FILE SW CODES. 10000020 .*( 10500020 *2810 11000020 .*) 11500020 &EBDPL SETA &PRM(3)/8 12000020 &EBIR0 SETA 7-&PRM(3)+(&EBDPL*8) 14000020 &EBIR1 SETB (&EBIR0 GT 0) 16000020 &EBIR2 SETB (&EBIR0 GT 1) 18000020 &EBIR3 SETB (&EBIR0 GT 2) 20000020 &EBIR4 SETB (&EBIR0 GT 3) 22000020 &EBIR5 SETB (&EBIR0 GT 4) 24000020 &EBIR6 SETB (&EBIR0 GT 5) 26000020 &EBIR7 SETB (&EBIR0 GT 6) 28000020 &EBBIT SETA 1*(1+&EBIR1)*(1+&EBIR2)*(1+&EBIR3)*(1+&EBIR4)*(1+&EBIR5)C30000020 *(1+&EBIR6)*(1+&EBIR7) 32000020 LA CR1,UBYPAS(CR2) 34000020 TM &EBDPL.(CR1),&EBBIT IS NEXT PHASE TO BE BYPASSED 36000020 BZ &FTC YES 38000020 AIF ('&PRM(2)' NE 'YES').EBM01 40000020 XI 0(CR1),X'80' REVERSE LOG FILE SWITCH 42000020 LM CR6,CR9,UCWKB(CR2) SWITCH ASSIGNMENTS OF FILES 44000020 L CR10,8(CR6) B AND C BY SWITCHING THE 46000020 L CR11,8(CR8) A(DCB) FIELDS IN THE DECB'S 48000020 ST CR10,8(CR8) OF B AND C 50000020 ST CR10,8(CR9) 52000020 ST CR11,8(CR6) 54000020 ST CR11,8(CR7) 56000020 LM CR6,CR7,UCDCBB(CR2) SWITCH DCB POINTERS FOR 58000020 ST CR6,UCDCBC(CR2) FILE C AND 60000020 ST CR7,UCDCBB(CR2) FILE B 62000020 .EBM01 ANOP 64000020 MEND 66000020 ./ ADD SSI=01012800,SOURCE=1,NAME=CIOP MACRO 00020000 CIOP &PHASE=,&ENTRY=CBEGIN,&EOFWK=CEOD,&EOFIPT=EOFIPT, C00040000 &EOFLIB=EOFLIB,&INPUT=INPUT,&LIST=LIST,&PUNCH=PUNCH, C00060000 &NFLIB=NFLIB,&DATE=NODATE,&INREG=3,&OUTREG=4, C00080000 &SKIPPH=NOSKP 00100000 .* NOTES ON SKIPPH= PARAM... 00120000 .* A DYNAMIC PHASE BYPASS SCHEME IS PROVIDED TO PERMIT 00140000 .* THOSE PHASES NOT REQUIRED IN A GIVEN COMPILATION TO 00160000 .* BE BYPASSED (I.E., NEVER LOADED). 00180000 .* IN THE PHASE(S) PRECEEDING A BYPASSABLE PHASE, SKIPPH IS... 00200000 .* SKIPPH=(BYPASS-PHASE,LOG-FILE,BIT-NUM,FOLLOWING-PHASE) 00220000 .* * BYPASS-PHASE IS NAME OF BYPASSABLE PHASE(EG,DST) 00240000 .* * LOG-FILE IS 'YES'IF B-C OR C-B FILE COPY IN PHASE. 00260000 .* * BIT-NUM IS NUMBER OF BIT IN UBYPAS ASS'G TO PHASE. 00280000 .* FOLLOWING-PHASE IS FIRST NON-BYPASSABLE PHASE 00300000 .* *-THESE 3 REPEATED IF SEVERAL CONSECUTIVE PHASES 00320000 .* ARE BYPASSABLE... E.G... 00340000 .* SKIPPH=(A1,A2,A3,B1,B2,B3,C1,C2,C3,D1) 00360000 .* (A,B,C, BYPASSABLE, D IS NOT). 00380000 .* A BIT OF THE COMMON ARRAY'UBYPAS' IS ASSIGNED TO 00400000 .* THE PHASE TO BE BYPASSED AND AT ANY TIME PRIOR TO 00420000 .* THAT PHASE THAT IT IS DETERMINED THAT THAT PHASE 00440000 .* MAY BE NEEDED, ITS BIT IS SET. IN THE IMMED. PRECEED- 00460000 .* ING PHASE (AS WELL AS POSSIBLY EARLIER IF SEVERAL 00480000 .* CONSECUTIVE PHASES ARE BYPASSABLE) THE CALL-NEXT-PHASE 00500000 .* OPERATION IN THE 'CEXIT' PART OF ITS CIOP WILL 00520000 .* BE CHANGED TO... 00540000 .* CIBYFT NEXT=&SKIPPH 00560000 .* NOTE... FIRST BIT (NUM 0) OF UBYPAS RESERVED FOR LOG FILE SW 00580000 .* BUT IS NOT USED IN OS. LOG FILES ARE SWITCHED BY REVERS- 00600000 .* ING DECB'S IN COMMON. 00620000 LCLA &SKIPS 00640000 LCLB &XPH,&TRM 00660000 LCLB &CSA,&CSB 00680000 LCLC &D,&CIOP,&NEXT,&SIO,&NPH,&LPH,&FC,&TC 00700000 LCLC &CSNA,&CSNB 00720000 .*( 00725017 *2800007300,057600 3782 00730020 .*) 00735017 &CSNA SETC 'IEP&PHASE.A' 00740000 &CSNB SETC 'IEP&PHASE.B' 00760000 IEP&PHASE.00 CSECT 00780000 AIF ('&PHASE' NE 'CBL').P1 00800000 &NEXT SETC ' SYSNN' 00820000 &CIOP SETC 'X ' 00840000 &SIO SETC ' ' 00860000 &XPH SETB 1 00880000 AGO .P99 00900000 .P1 AIF ('&PHASE'NE 'SYS').P2 00920000 &NEXT SETC 'DPCSETNN' 00940000 &CIOP SETC 'X ' 00960000 &SIO SETC ' ' 00980000 &XPH SETB 1 01000000 AGO .P99 01020000 .P2 AIF ('&PHASE' NE 'SET').P3 01040000 &NEXT SETC 'DS1 X' 01060000 &CIOP SETC 'X ' 01080000 &SIO SETC ' ' 01100000 &XPH SETB 1 01120000 &TRM SETB 1 01140000 CTERMC EQU 0 EARLY TERMINATION CODE FOR SET 01160000 AGO .P99 01180000 .P3 AIF ('&PHASE' NE 'DS1').P4 01200000 &NEXT SETC 'DS2 X' 01220000 &CIOP SETC ' CN VC' 01240000 &SIO SETC 'LIO O ' 01260000 &TRM SETB 1 01280000 CTERMC EQU 1 EARLY TERMINATION CODE FOR DS1 01300000 &CSA SETB 1 01320000 AGO .P99 01340000 .P4 AIF ('&PHASE' NE 'DS2').P5 01360000 &NEXT SETC ' ' 01380000 &CIOP SETC ' CN VC' 01400000 &SIO SETC 'LIO 2 ' 01420000 &TRM SETB 1 01440000 CTERMC EQU 2 EARLY TERMINATION CODE FOR DS2 01460000 &CSA SETB 1 01480000 AGO .P99 01500000 .P5 AIF ('&PHASE' NE 'DPC').P8 01520000 &NEXT SETC 'ALC X' 01540000 &CIOP SETC 'AB CVA' 01560000 &SIO SETC ' O3 ' 01580000 &CSA SETB 1 01600000 AGO .P99 01620000 .P8 AIF ('&PHASE' NE 'DST').P8ALC 01640000 &NEXT SETC 'ALC X' 01660000 &CIOP SETC 'AB CVA' 01680000 &SIO SETC ' O3 ' 01700000 &CSA SETB 1 01720000 AGO .P99 01740000 .P8ALC AIF ('&PHASE' NE 'ALC').P9 01760000 &NEXT SETC 'BLD X' 01780000 &CIOP SETC 'A C B RA' 01800000 &SIO SETC ' O3 ' 01820000 &TRM SETB 1 01840000 CTERMC EQU 3 EARLY TERMINATION CODE FOR ALC 01860000 &CSA SETB 1 01880000 AGO .P99 01900000 .P9 AIF ('&PHASE' NE 'BLD').P10 01920000 &NEXT SETC 'DMG X' 01940000 &CIOP SETC 'N A CN ' 01960000 &SIO SETC ' O5 ' 01980000 &CSA SETB 1 02000000 AGO .P99 02020000 .P10 AIF ('&PHASE' NE 'DMG').P11 02040000 &NEXT SETC 'LIT X' 02060000 &CIOP SETC ' CA RC' 02080000 &SIO SETC ' O4 ' 02100000 &FC SETC 'A' 02120000 &TC SETC 'A' 02140000 AGO .P99 02160000 .P11 AIF ('&PHASE' NE 'LIT').P12 02180000 &NEXT SETC 'IOT X' 02200000 &CIOP SETC ' CA RC' 02220000 &SIO SETC ' 3 ' 02240000 &CSA SETB 1 02260000 AGO .P99 02280000 .P12 AIF ('&PHASE' NE 'IOT').P13 02300000 &NEXT SETC 'SIS X' 02320000 &CIOP SETC 'A CRA' 02340000 &SIO SETC ' O1 ' 02360000 &CSA SETB 1 02380000 &CSB SETB 1 02400000 AGO .P99 02420000 .P13 AIF ('&PHASE' NE 'SIS').P14 02440000 &NEXT SETC 'PS1PMGNX' 02460000 &CIOP SETC 'X ' 02480000 &SIO SETC ' ' 02500000 &XPH SETB 1 02520000 AGO .P99 02540000 .P14 AIF ('&PHASE' NE 'PMG' AND '&PHASE' NE 'SMG').P15 02560000 &NEXT SETC 'LST X' 02580000 &CIOP SETC ' CN RA' 02600000 &SIO SETC 'LIO O6 ' 02620000 &CSA SETB 1 02640000 AGO .P99 02660000 .P15 AIF ('&PHASE' NE 'LST').P16 02680000 &NEXT SETC ' ' 02700000 &CIOP SETC 'X ' 02720000 &SIO SETC ' O ' 02740000 &FC SETC 'A' 02760000 &TC SETC 'A' 02780000 AGO .P99 02800000 .P16 AIF ('&PHASE' NE 'PS1').P17 02820000 &NEXT SETC 'PS2 ' 02840000 &CIOP SETC 'AB CN ' 02860000 &SIO SETC ' O ' 02880000 &CSA SETB 1 02900000 &CSB SETB 1 02920000 AGO .P99 02940000 .P17 AIF ('&PHASE' NE 'PS2').P18 02960000 &NEXT SETC 'PS3 ' 02980000 &CIOP SETC 'AB CN ' 03000000 &SIO SETC ' O3 ' 03020000 &CSA SETB 1 03040000 &CSB SETB 1 03060000 AGO .P99 03080000 .P18 AIF ('&PHASE' NE 'PS3').P19 03100000 &NEXT SETC 'PS4 ' 03120000 &CIOP SETC 'AB CN ' 03140000 &SIO SETC ' O ' 03160000 &CSA SETB 1 03180000 &CSB SETB 1 03200000 AGO .P99 03220000 .P19 AIF ('&PHASE' NE 'PS4').P19A 03240000 &NEXT SETC 'PG1 ' 03260000 &CIOP SETC 'AB CN ' 03280000 &SIO SETC ' O3 ' 03300000 &CSA SETB 1 03320000 &CSB SETB 1 03340000 AGO .P99 03360000 .P19A AIF ('&PHASE' NE 'PG1').P20 03380000 &NEXT SETC 'PG2 ' 03400000 &CIOP SETC 'A CAB N ' 03420000 &SIO SETC ' O8A ' 03440000 &TC SETC 'P' 03460000 &CSA SETB 1 03480000 &CSB SETB 1 03500000 AGO .P99 03520000 .P20 AIF ('&PHASE' NE 'PG2').P21 03540000 &NEXT SETC 'PG3 ' 03560000 &CIOP SETC 'A CAB N ' 03580000 &SIO SETC ' O8A ' 03600000 &TC SETC 'P' 03620000 &CSA SETB 1 03640000 AGO .P99 03660000 .P21 AIF ('&PHASE' NE 'PG3').P22 03680000 &NEXT SETC 'PG4 ' 03700000 &CIOP SETC 'A CAB N ' 03720000 &SIO SETC ' O8A ' 03740000 &TC SETC 'P' 03760000 &CSA SETB 1 03780000 &CSB SETB 1 03800000 AGO .P99 03820000 .P22 AIF ('&PHASE' NE 'PG4').P22A 03840000 &NEXT SETC 'PG5 ' 03860000 &CIOP SETC 'A CAB N ' 03880000 &SIO SETC ' ' 03900000 &CSA SETB 1 03920000 &CSB SETB 1 03940000 AGO .P99 03960000 .P22A AIF ('&PHASE' NE 'PG5').P22B 03980000 &NEXT SETC 'PG6 ' 04000000 &CIOP SETC 'A CAB N ' 04020000 &SIO SETC ' O3 ' 04040000 &CSA SETB 1 04060000 AGO .P99 04080000 .P22B AIF ('&PHASE' NE 'PG6').P22C 04100000 &NEXT SETC 'PG7 ' 04120000 &CIOP SETC 'A CAB N ' 04140000 &SIO SETC ' O8A ' 04160000 &TC SETC 'P' 04180000 &CSA SETB 1 04200000 &CSB SETB 1 04220000 AGO .P99 04240000 .P22C AIF ('&PHASE' NE 'PG7').P22D 04260000 &NEXT SETC 'PGP ' 04280000 &CIOP SETC 'A CAB N ' 04300000 &SIO SETC ' O3 ' 04320000 &CSA SETB 1 04340000 &CSB SETB 1 04360000 AGO .P99 04380000 .P22D AIF ('&PHASE' NE 'PGP').P22EA 04400000 &NEXT SETC 'PGQ ' 04420000 &CIOP SETC 'A CAB N ' 04440000 &SIO SETC ' O8A ' 04460000 &TC SETC 'P' 04480000 &CSA SETB 1 04500000 AGO .P99 04520000 .P22EA AIF ('&PHASE' NE 'PGQ').P22EB 04540000 &NEXT SETC 'PG9 ' 04560000 &CIOP SETC 'A CAB N ' 04580000 &SIO SETC ' O8A ' 04600000 &TC SETC 'P' 04620000 &CSA SETB 1 04640000 AGO .P99 04660000 .P22EB AIF ('&PHASE' NE 'PG9').P23 04680000 &NEXT SETC 'ASP X' 04700000 &CIOP SETC 'A CAB N ' 04720000 &SIO SETC ' O8A ' 04740000 &TC SETC 'P' 04760000 &CSA SETB 1 04780000 &CSB SETB 1 04800000 AGO .P99 04820000 .P23 AIF ('&PHASE' NE 'ASP').P24 04840000 &NEXT SETC ' AS1NN' 04860000 &CIOP SETC 'X ' 04880000 &SIO SETC ' ' 04900000 &XPH SETB 1 04920000 AGO .P99 04940000 .P24 AIF ('&PHASE' NE 'AS1').P24A 04960000 &NEXT SETC 'AS2 X' 04980000 &CIOP SETC ' CA RC' 05000000 &SIO SETC ' PO3 ' 05020000 &TRM SETB 1 05040000 CTERMC EQU 4 05060000 &CSA SETB 1 05080000 AGO .P99 05100000 .P24A AIF ('&PHASE' NE 'AS2').P24B 05120000 &NEXT SETC 'ASA X' 05140000 &CIOP SETC 'A CRA' 05160000 &SIO SETC ' P ' 05180000 &TRM SETB 1 05200000 CTERMC EQU 4 05220000 &CSA SETB 1 05240000 AGO .P99 05260000 .P24B AIF ('&PHASE' NE 'ASA').P24BA 05280000 &NEXT SETC 'AS3 X' 05300000 &CIOP SETC 'N N N ' 05320000 &SIO SETC ' PO7 ' 05340000 &TRM SETB 1 05360000 CTERMC EQU 4 05380000 &CSA SETB 1 05400000 AGO .P99 05420000 .P24BA AIF ('&PHASE' NE 'AS3').P24C 05440000 &NEXT SETC 'AS4 X' 05460000 &CIOP SETC 'A CRA' 05480000 &SIO SETC ' P ' 05500000 &TRM SETB 1 05520000 CTERMC EQU 4 05540000 &CSA SETB 1 05560000 AGO .P99 05580000 .P24C AIF ('&PHASE' NE 'AS4').P24D 05600000 &NEXT SETC 'AS5 X' 05620000 &CIOP SETC 'A CRA' 05640000 &SIO SETC ' PO7 ' 05660000 &CSA SETB 1 05680000 AGO .P99 05700000 .P24D AIF ('&PHASE' NE 'AS5').P25 05720000 &NEXT SETC 'ASW X' 05740000 &SIO SETC ' P ' 05780000 &TRM SETB 1 05800000 CTERMC EQU 4 05820000 &CSA SETB 1 05840000 AGO .P99 05860000 .P25 AIF ('&PHASE' NE 'ASW').P26 05880000 &NEXT SETC ' AS6NN' 05900000 &CIOP SETC 'X ' 05920000 &SIO SETC ' ' 05940000 &XPH SETB 1 05960000 AGO .P99 05980000 .P26 AIF ('&PHASE' NE 'AS6').P27 06000000 &NEXT SETC 'PD1 X' 06020000 &CIOP SETC 'A CN ' 06040000 &SIO SETC ' OPO3 ' 06060000 &CSA SETB 1 06080000 &FC SETC 'S' 06100000 AGO .P99 06120000 .P27 AIF ('&PHASE' NE 'PD1').P27A 06140000 &NEXT SETC 'PD2 X' 06160000 &CIOP SETC ' A N ' 06180000 &SIO SETC ' O7 ' 06200000 &CSA SETB 1 06220000 AGO .P99 06240000 .P27A AIF ('&PHASE' NE 'PD2').P28 06260000 &NEXT SETC ' ' 06280000 &CIOP SETC 'X ' 06300000 &SIO SETC ' O ' 06320000 &CSA SETB 1 06340000 AGO .P99 06360000 .P28 MEXIT 06380000 .P99 ANOP 06400000 &SKIPS SETA N'&SKIPPH 06420000 AIF (&SKIPS GT 1).SKIP1 06440000 &LPH SETC '&NEXT'(1,3) 06460000 &NPH SETC '&NEXT'(4,3) 06480000 .SKIP1 ANOP 06500000 CR0 EQU 0 *** REGISTER EQUATES FOR CIOP *** 06520000 CR1 EQU 1 06540000 CR2 EQU 2 06560000 CR3 EQU 3 06580000 CR4 EQU 4 06600000 CR5 EQU 5 06620000 CR6 EQU 6 06640000 CR7 EQU 7 06660000 CR8 EQU 8 06680000 CR9 EQU 9 06700000 CR10 EQU 10 06720000 CR11 EQU 11 06740000 CR12 EQU 12 06760000 CR13 EQU 13 06780000 CR14 EQU 14 06800000 CR15 EQU 15 06820000 C0 EQU 0 *** REGISTER EQUATES FOR PHASES ** 06840000 C1 EQU 1 06860000 C2 EQU 2 06880000 C3 EQU 13 06900000 C4 EQU 14 06920000 C5 EQU 15 06940000 B1 EQU 5 BASE REG NO. 1 06960000 B2 EQU 6 BASE REG NO. 2 06980000 B3 EQU 7 BASE REG NO. 3 07000000 L1 EQU 8 LINK REG 07020000 P1 EQU 9 PARM REG 07040000 W1 EQU 10 07060000 W2 EQU 11 07080000 W3 EQU 12 07100000 S1 EQU 3 INPUT REG 07120000 S2 EQU 4 OUTPUT REG 07140000 INREG EQU &INREG 07160000 OUTREG EQU &OUTREG 07180000 * EQUATE INSTRUCTIONS FOR COMMON AREA 07200000 * INSTRUCTION STOR/ALLOC DESCRIPTION 07220000 UPCRD EQU 0 CL80 FIRST CARD OF PROCEDURE DIV. 07240000 UPNAM EQU 80 D PROGRAM NAME FROM SOURCE 07260000 UBASE EQU 88 F DISPLACEMENT FROM MAP PARM 07280000 UERRS EQU 92 C DIAGNOSTIC SEVERITY LEVEL SWITCH 07300000 * BIT 0 - D , BIT 1 - E , BIT 2 - C , BIT 3 - W 07320000 USUBR EQU 94 2D OBJ. TIME SUBROUTINES CALLED 07340000 UIOTB EQU 112 INDICATES OBJECT TIME SUBROUTINES 07360000 USMTB EQU 115 INDICATES OBJECT TIME SUBROUTINES 07380000 UTEMB EQU 118 INDICATES OBJECT TIME SUBROUTINES 07400000 USTBA EQU 121 INDICATES OBJECT TIME SUBROUTINES 07420000 UATSG EQU 128 C NO. OF SEGMENTS 07440000 USGTB EQU 129 4C NOTEWORD OF SEG TABLE 07460000 UGTEM EQU 139 C NUMBER OF GENERATED TEMPORARIES 07480000 USSEQ EQU 140 3H PREVIOUS SOURCE SEQ. NUMBER 07500000 USRCE EQU 146 H COUNT OF SOURCE 07520000 URGBL EQU 148 3H REG/BL OF LABEL REC DATA NAME 07540000 UBLOC EQU 154 H COUNT OF BASE LOCATORS 07560000 UDCBF EQU 156 9C DCB FOR FORMS OFLO NAME 07580000 UWORK EQU 165 C SIZE OF WORK AREAS 07600000 UATBL EQU 166 H SIZE OF ATTRIBUTE TABLE 07620000 UWSIZ EQU 168 F WORKING STORAGE CORE SIZE 07640000 UISEQ EQU 172 H INTERNAL SEQUENCE NUMBER 07660000 USTBL EQU 174 H SIZE OF SUPP. ATRIB. TABLE 07680000 UGNLB EQU 176 H COUNT OF GENERATED LABELS 07700000 UAOPT EQU 178 H ACCEPT OPTION USED 07720000 UCLOS EQU 182 H 1ST B.L. ASSIGNED TO FILE SEC. 07740000 UALST EQU 187 C NUMBER OF ALTERNATE STATEMENTS 07760000 UWSRG EQU 191 C REG. ASSIGNED TO WORKING STOR. 07780000 UBDIS EQU 192 3C ADR. IN BASE/DIS. FORM 07800000 UDOPT EQU 195 07820000 UNEXT EQU 196 3C NEXT BASE/DIS IN W.S. (END) 07840000 USWCH EQU 199 C SWITCH BYTE 07860000 * 0 BIT - TRACE SWITCH 1 BIT - SEGMENTED ATRIB TABLE 07880000 * 2 BIT - ALTER SWITCH 3 BIT - PERFORM SWITCH 07900000 * 4 BIT - SECTION SWITCH 5 BIT - FLOATING POINT 07920000 * 6 BIT - SUBPROGRAM 07940000 UHASH EQU 203 3C HASH TABLE ADDRESS 07960000 ULINK EQU 209 C LAST BASE ASSIGNED TO LINKAGE 07980000 UGENL EQU 210 H HIGHEST GENERATED LABEL USED 08000000 UNSLA EQU 228 H NUMBER OF SOURCE LABELS 08020000 UNEXC EQU 230 H NO. ENTRY PNTS. FOR EXTRN CALL 08040000 UNALS EQU 232 H NO. OF ALTERED STATEMENTS 08060000 UNCSR EQU 234 H NO. OF SUBROUTINES CALLED 08080000 UNLIT EQU 236 H NUMBER OF LITERALS 08100000 UNUST EQU 238 C NO. EXITS FOR CHKPT OR LABELS 08120000 UCOMA EQU 239 C AREA FOR COMMA 08140000 UPOIN EQU 240 C AREA FOR PERIOD 08160000 UBYPAS EQU 241 ONE BYTE AREA FOR PHASE BYPASS SCHEME 08180000 * BIT 0 = LOG FILE SW 08200000 * BIT 1 = DST TO BE CALLED IF ON 08220000 CUBYPS EQU UBYPAS EQUATE DOS & OS SYMBOLS FOR SYS INDEPCE 08240000 UDCBR EQU 244 F ADDR OF DCB FOR RERUN 08260000 UBUCK EQU 248 F CTR FOR 01 & 77 IN LINKAGE SEC 08280000 USEGS EQU 293 X'00' IF DICTIONARY HAS NOT 000E 08282018 * BEEN SEGMENTED 000E 08284018 * X'40' IF DICTIONARY HAS BEEN 000E 08286018 * SEGMENTED 000E 08288018 UCNTS EQU 294 H COUNT OF SOURCE RECORDS 000E 08290018 UCNTD EQU 296 H COUNT OF DATA ITEMS 000E 08292018 UCNTP EQU 298 H COUNT OF VERBS IN PROC DIV. 000E 08294018 ULNCT EQU 300 2H LINES/PAGE & LINE COUNTER 08300000 UCNCD EQU 304 08320000 UXDSP EQU X'40' UCNCD-DISPLAY OBJECT CHECK-1 IS YES 08340000 UXFLG EQU X'20' UCNCD-DIAGS, 1 IS NO WARNINGS 08360000 UXEDT EQU X'10' UCNCD-PICTURE. 1 FOR INVERTED EDIT 08380000 UXBUG EQU X'8' UCNCD-1 FOR DEBUG OPTION 08400000 UXPF2 EQU X'1' UCNCD- 00 - PFM1 01 - PFM2 08420000 UXPF3 EQU X'2' UCNCD 10 - PFM3 08440000 UCNCE EQU 305 08460000 UXLST EQU X'80' UCNCE- 1 FOR NO SOURCE LIST 08480000 UXDEK EQU X'40' UCNCE- 1 FOR NO DECK 08500000 UXDMP EQU X'20' UCNCE- 1 FOR NO DMAP 08520000 UXPMP EQU X'10' UCNCE- 1 FOR NO PMAP 08540000 UXERR EQU X'8' UCNCE- 1 IF NOSPIE 000E 08560018 USTSZ EQU 150 SEG TABLE SIZE--NOT IN COMM AREA 08580000 UCWKA EQU 400 POINTERS TO WORK A DECB'S 08600000 UCWKB EQU 408 POINTERS TO WORK B DECB'S 08620000 UCWKC EQU 416 POINTERS TO WORK C DECB'S 08640000 UCDCBIN EQU 424 POINTER TO SYSIN DCB 08660000 UCDCBOUT EQU 428 POINTER TO SYSOUT DCB 08680000 UCDCBLIB EQU 432 POINTER TO SYSLIB DCB 08700000 UCDCBA EQU 436 POINTER TO SYSUT1 DCB 08720000 UCDCBB EQU 440 POINTER TO SYSUT2 DCB 08740000 UCDCBC EQU 444 POINTER TO SYSUT3 DCB 08760000 UCDCBPCH EQU 448 POINTER TO SYSPUNCH DCB 08780000 UCTBADR EQU 452 ADR OF CORE FROM LATEST GETMAIN 08800000 UCTBSZ EQU 456 SIZE OF CORE FROM LATEST GETMAIN 08820000 UCATAB EQU 464 SIZE OF GETMAIN FOR ATRIB. TABLE 08840000 UCPSEQ EQU 464 3C SEQ FOR PUNCH, OVERLAY UCATAB 08860000 UCDEBUG EQU 468 ADR OF DEBUG MODULE, IF CALLED 08880000 UCSW EQU 472 FRAME SWITCHES 08900000 CXIFA EQU X'80' UCSW- 1 IF INVERTED FILE ASSIGNMENTS 08920000 UCSTAB EQU 476 08940000 UCMAX EQU 480 08960000 UCREP EQU 484 08980000 UCINVLST EQU 500 PARAMETERS FOR INVOCATION 09000000 *DISPLACEMENTS OF FIELDS IN DCBS 09020000 CDEVT EQU 17 DCBDEVT 09040000 CTAPE EQU X'81' DEVT CODE FOR TAPE FILES 09060000 CEODAD EQU 32 DCBEODAD 09080000 CBLKSI EQU 62 DCBBLKSIZE 09100000 *DISPLACEMENTS OF FIELDS IN THE EXTENDED DECB **STORED BY ** 09120000 CTTP EQU 4 TYPE OPERAND COPEN 09140000 CTLT EQU 6 LENGTH OPERAND CPUT 09160000 CTDCB EQU 8 DCB ADDRESS CONSTANT 09180000 CTAR EQU 12 AREA POINTER BUFFER ASSIGN 09200000 CTPT EQU 20 POSITION IN BUFFER CPUT & CGET 09220000 CTLX EQU 24 LIMIT OF BUFFER COPEN 09240000 CTSZ EQU 28 BUFFER SIZE SET 09260000 CTSWCH EQU 30 ONE BYTE FOR SWITCHES 09280000 CDWRT EQU X'80' ON WHEN BUFFER HAS BEEN WRITTEN ONCE 09300000 CET&PHASE STM CR14,CR12,12(CR13) 09320000 BALR B1,0 09340000 AIF (NOT &XPH).XPH0 09360000 USING *,B1 09380000 ST CR13,CRSAVE+4 STORE LOCATION OF HIGHER LEVEL S.A. 09400000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 09420000 AGO .XPH1 09440000 .XPH0 USING *,B1 09460000 AIF (NOT &CSA).CSEND 09480000 USING &CSNA,B2 09500000 L B2,=A(&CSNA) 09520000 AIF (NOT &CSB).CSEND 09540000 USING &CSNB,B3 09560000 L B3,=A(&CSNB) 09580000 .CSEND AIF ('&PHASE'(1,2) NE 'AS').CSEND1 09600000 USING XASTBLOC,B3 09620000 .CSEND1 ST CR13,CRSAVE+4 STORE ADR OF SAVE AREA 09640000 AIF ('&CIOP'(1,1) EQ 'X').SQO 09660000 MVC CWKA(24),UCWKA(CR2) MOVE IN POINTERS TO WK FILE DECB'S 09680000 .SQO ST CR2,CCOMM PUT ADR OF COMMON AREA IN LOCAL BKT 09700000 AIF ('&PHASE' NE 'AS6').NLNCT 09720000 MVC CLNCT(2),ULNCT(CR2) MOVE IN LINE COUNT BUCKET 09740000 AGO .XLNCT 09760000 .NLNCT MVC CLNCT(4),ULNCT(CR2) MOVE IN LINE COUNT & REMAINDER 09780000 .XLNCT L CR9,UCDEBUG(CR2) T LOAD ADR OF DEBUG MODULE 09800000 ST CR9,CDEBUG T STORE FOR LATER USE 09820000 LA CR13,CRSAVE T POINT TO SAVE AREA FOR DEBUG 09840000 LA CR15,CNAME T POINT TO PHASE NAME 09860000 BALR L1,CR9 T LINK TO DEBUG ROUTINE FOR ENTRY 09880000 DC H'1' T INDICATES ENTRY 09900000 .XPH1 AIF ('&PHASE' NE 'PD1').PDG1 09920000 BAL L1,CCLOSE DO CCLOSE FOR AS2 09940000 DC X'02040000' 09960000 LM CR8,CR9,UCWKA(CR2) POINT TO WKA DECB'S 09980000 LM CR10,CR11,UCWKC(CR2) POINT TO WK C DECB'S 10000000 L CR1,CTAR(CR8) POINT TO 1ST WKA BUFFER 10020000 C CR1,CTAR(CR9) IS IT THE LOWER 10040000 BL CPDG1 IF YES O.K. 10060000 L CR1,CTAR(CR9) ELSE LOAD THE LOWER 10080000 CPDG1 LH CR0,CTSZ(CR8) LOAD SIZE OF WKA BUFFER 10100000 AR CR0,CR0 DOUBLE FOR TOTAL TO FREE 10120000 ST CR0,CWPDG1 STORE FOR LATER USE 10140000 LA CR13,CRSAVE 10160000 * FREEMAIN R,LV=(0),A=(1) 10180000 FREEMAIN R,LV=(0),A=(1) 10200000 L CR1,CTAR(CR10) LOAD ADR OF 1ST WKC BUFFER 10220000 L CR0,CTAR(CR11) LOAD ADR OF 2ND WKC DECB 10240000 CR CR1,CR0 IS LOWER OF THE TWO IN CR1 10260000 BL CPDG2 IF YES O.K. 10280000 LR CR1,CR0 ELSE GET THE LOWER IN CR1 10300000 L CR0,CTAR(CR10) AND HIGHER IN CR0 10320000 CPDG2 AH CR0,CTSZ(CR10) ADD LENGTH OF WK B BUFFER TO ADR OF 10340000 SH CR0,CTSZ(CR8) HIGHER BUFFER, SUBTRACT LENGTH OF 10360000 ST CR0,CTAR(CR9) WKA BUFFER TO GIVE ADR OF NEW 2ND 10380000 SH CR0,CTSZ(CR8) WKA BUFFER, THEN DUNK AGAIN TO GIVE 10400000 ST CR0,CTAR(CR8) ADR OF NEW 1ST WKA BUFFER. THEN 10420000 ST CR0,CWPDG1+4 STORE FOR LATER USE 10440000 SR CR0,CR1 CALC LENGTH OF LEFT OVER TO FREE 10460000 BZ CPDG3 BRANCH IF NO LEFT OVER 10480000 * FREEMAIN R,LV=(0),A=(1) 10500000 FREEMAIN R,LV=(0),A=(1) 10520000 CPDG3 EQU * 10540000 .PDG1 AIF ('&TC' NE 'A').STC 10560000 MVC CCORAD(4),UCTBADR(CR2) 10580000 .STC AIF ('&TC' NE 'P').NPT 10600000 LA CR13,CRSAVE 10620000 GETMAIN VU,LA=CPTAB,A=CCORAD 10640000 LM CR11,CR12,CCORAD LOAD ADR & SIZE OF EXTRA CORE 10660000 LR CR1,CR11 PREPARE TO FREE LOWER 600 BYTES FOR 10680000 LA CR0,800 SPACE FOR END OF EXTENT ROUTINES 10700000 AR CR11,0 BUMP POINTER TO EXTRA CORE 10720000 SR CR12,0 DUNK SIZE OF EXTRA CORE 10740000 STM CR11,CR12,CCORAD STORE ADR AND SIZE OF EXTRA CORE 10760000 * FREEMAIN R,LV=(0),A=(1) FREE ENOUGH CORE FOR END OF EXTENT 10780000 FREEMAIN R,LV=(0),A=(1) FREE ENOUGH CORE FOR END OF EXTENT 10800000 .NPT AIF ('&SIO'(1,4) NE 'LIO ').NIN1 10820000 LM CR8,CR12,0(CR3) LOAD POINTERS TO SYS FILE DECB'S 10840000 STM CR8,CR12,CPCON STORE IN LOCAL AREAS 10860000 LA CR1,UPCRD(CR2) POINT TO CARD AREA IN COMMON 10880000 ST CR1,&INPUT STORE ITS ADR AS 1ST BUFFER 10900000 LM CR15,CR1,UCDCBIN(CR2) POINT TO SYSIN & SYSLIB DCBS 10920000 AIF ('&EOFIPT' EQ '').NEFIN 10940000 LA CR3,&EOFIPT LOAD ADR OF END OF FILE ROUTINE 10960000 ST CR3,CSAVE 10980000 MVC CEODAD+1(3,CR15),CSAVE+1 EOF ADR FOR SYSIN TO SYSIN DCB 11000000 .NEFIN MVC CEODAD+1(3,CR1),CFECON EOF ADR FOR SYSLIB TO DCB 11020000 MVC &LIST.(4),CTAR(CR8) SET POINTER TO PRINT AREA NO. 1 11040000 LR CR1,CR10 POINT TO CARD READER DECB 11060000 AIF ('&PHASE' NE 'DS2').MIX 11080000 MVC CTAR(4,CR10),20(CR10) RESET POINTER TO 2ND READ BUFFER 11100000 MVC CTAR(4,CR11),20(CR11) RESET LIBRARY BUFFER POINTER 11120000 .MIX LA CR13,CRSAVE POINT TO SAVE AREA FOR O/S USE 11140000 BAL CR14,CWRT READ FROM STANDARD LINKAGE 11160000 AGO .RIN 11180000 .NIN1 AIF ('&SIO'(1,4) NE ' O ').NIN2 11200000 LM CR9,CR10,0(CR3) LOAD POINTERS TO DECB'S 11220000 STM CR9,CR10,CPCON STORE IN LOCAL BUCKETS 11240000 AIF ('&PHASE' NE 'PD2').FLG1 11260000 MVI CPCON,X'0' SET UP FLAG FOR FIRST CHECK 11280000 .FLG1 MVC &LIST.(4),CTAR(CR9) SET POINTER TO PRINT AREA-1 11300000 AGO .RIN 11320000 .NIN2 AIF ('&PHASE'(1,2) NE 'AS' OR '&PHASE' EQ 'ASP' OR '&PHASE' C11340000 EQ 'ASW').RIN 11360000 LM CR9,CR10,0(CR4) POINTERS TO PUNCH DECB'S 11380000 STM CR9,CR10,CCCON STORE IN LOCAL BUCKETS 11400000 AIF ('&PHASE' NE 'AS6').RIN 11420000 LM CR9,CR10,0(CR3) POINTERS TO PRINT DECB'S 11440000 STM CR9,CR10,CPCON STORE IN LOCAL BUCKETS 11460000 BAL L1,CVC66 GO PRINT FIRST P-MAP HEADER 11480000 DC AL4(CHEAD1) 11500000 MVI CXP6+1,C'-' SET SPACING FOR LINE TWO OF HEAD 11520000 BAL L1,CVC66 GO PRINT SECOND P-MAP HEADER 11540000 DC AL4(CHEAD2) 11560000 MVI CXP6+1,C'0' SET TRIPLE SPACE BEFORE NEXT LINE 11580000 LH L1,CLNS 11600000 SH L1,CON4 DUNK LINE COUNT 4, FOR SPACES 11620000 STH L1,CLNS 11640000 .RIN AIF ('&PHASE' NE 'BLD').GCOR1 11660000 LA CR13,CRSAVE POINT TO SAVE AREA FOR O/S USE 11680000 MVC CSAVE+1(3),UHASH(CR2) GET ADR OF HASH TABLE FROM COMM 11700000 L CR9,CSAVE 11720000 MVC CHASH(256),0(CR9) M 11740000 MVC CHASH+256(246),256(CR9) 11760000 * *** ROUTINE TO FREE WKB BUFFERS, RELOCATING WKA BUFFERS *** 11780000 LM CR8,CR11,UCWKA(CR2) POINT TO DECB'S FOR WKA AND WKB 11800000 L CR0,CTAR(CR10) POINT TO 1ST WKB BUFFER 11820000 C CR0,CTAR(CR11) IS IT THE HIGHER OF THE WKB BUFFERS 11840000 BH CBLD1 IF YES O.K. 11860000 L CR0,CTAR(CR11) ELSE LOAD ADR OF HIGHER WKB BUFFER 11880000 CBLD1 L CR1,CTAR(CR8) LOAD ADR OF OLD WKA BUFFER 11900000 C CR1,CTAR(CR9) IS IT THE LOWER OF THE TWO 11920000 BL CBLD2 IF YES O.K. 11940000 L CR1,CTAR(CR9) ELSE LOAD ADR OF LOWER WKA BUFFER 11960000 CBLD2 AH CR0,CTSZ(CR11) CALC ADR OF HI WKB BUF + ITS LENGTH 11980000 SH CR0,CTSZ(CR8) MINUS LENGTH OF WKA BUFFER, TO GIVE 12000000 * NEW LOCATION OF 2ND WKA BUFFER. 12020000 ST CR0,CTAR(CR9) STORE LOCATION OF NEW WKA BUFFER 12040000 SH CR0,CTSZ(CR8) CALC ADR OF NEW 1ST WKA BUFFER 12060000 ST CR0,CTAR(CR8) STORE LOCATION OF NEW 1ST WKA BUFFER 12080000 SR CR0,CR1 CALC LENGTH FOR FREEMAIN 12100000 * FREEMAIN R,LV=(0),A=(1) 12120000 FREEMAIN R,LV=(0),A=(1) 12140000 MVC CSAVE+6(2),UATBL(CR2) SIZE OF ATRIB. TABLE TO F.W. 12160000 L CR1,CSAVE+4 LOAD SIZE OF ATRIB. TABLE 12180000 LA CR1,511(CR1) CALC UATBL+5+HTBL+4 12200000 C CR1,CBCOR IS REQUIREMENT LESS THAN MIN SIZE 12220000 BH CBLD3 IF NO SKIP 12240000 ST CR1,CBCOR EL2E STORE REQUIRMENT AS MIN 12260000 CBLD3 ST CR1,CBCOR+4 STORE REQUIREMENT AS MAXIMUM 12280000 * GETMAIN VU,LA=CBCOR,A=CCORAD 12300000 GETMAIN VU,LA=CBCOR,A=CCORAD 12320000 LM CR9,CR10,CCORAD LOAD ADR AND SIZE OF RETURNED CORE 12340000 STM CR9,CR10,UCTBADR(CR2) STORE FOR LATER FREEMAIN 12360000 LA CR8,502 LOAD SIZE OF HTABL 12380000 LA CR11,0(CR9,CR10) POINT TO LIMIT OF AREA 12400000 SR CR11,CR8 POINT TO UPPER 502 BYTES 12420000 MVC 0(256,CR11),CHASH STORE HASH TABLE FOR DMG 12440000 MVC 256(246,CR11),CHASH+256 12460000 ST CR11,CSAVE STORE ADR OF HASH TABLE FOR MOVE 12480000 MVC UHASH(3,CR2),CSAVE+1 MOVE ADR OF HASH TABLE TO COMM 12500000 LA CR9,506 LOAD SIZE OF HASH TABLE + PREFIX 12520000 SR CR10,CR9 REDUCE SIZE OF CORE BY THAT 12540000 ST CR10,CCORSZ STORE SIZE OF AVAIL CORE 12560000 LM CR10,CR11,UCDCBA(CR2) POINT TO DCB'S FOR WKA & WKB 12580000 CLI CDEVT(CR10),CTAPE IS WKA ON TAPE 12600000 BNE *+10 IF NOT LEAVE BLKSIZE FOR DISK 12620000 MVC CBLKSI(2,CR10),CTAPB ELSE PLUG TAPE FILE BLKSIZE 12640000 CLI CDEVT(CR11),CTAPE IS WKB ON TAPE 12660000 BNE *+10 IF NOT LEAVE DISK BLKSIZE 12680000 MVC CBLKSI(2,CR11),CTAPB ELSE PLUG BLOCKSIZE FOR TAPE 12700000 .GCOR1 AIF ('&PHASE' NE 'AS1').NFP 12720000 ZAP UCPSEQ(3,CR2),CONE(1) INITIALIZE OBJECT DECK SEQ. NO. 12740000 * *** ROUTINE TO FREE CORE ASSIGNED TO WORK B **** 12760000 LM CR8,CR11,CWKB LOAD POINTERS TO WKB & C DECB'S 12780000 TM UCSW(CR2),CXIFA IS WKC CURRENTLY ASSIGNED TO UT3 12800000 BZ CASF2 IF ZERO IT IS.. SKIP NEXT ROUTINE. 12820000 * *** TO AVOID FRAGMENTING CORE, IF WK C IS ON SYSUT2 WE FLUSH 12840000 * *** ITS BUFFERS, FREE THEM, AND ASSIGN THE WK B BUFFERS TO C 12860000 LR CR1,CR10 POINT TO DECB WITH PARAM REG 12880000 L CR12,CTAR(CR1) POINT TO BUFFER 12900000 L CR14,CTPT(CR1) LOAD CURRENT POINTER TO BUFFER 12920000 SR CR14,CR12 CALC CURRENT SIZE OF BUFFER OCCUPIED 12940000 STH CR14,CTLT(CR1) STORE LENGTH IN DECB 12960000 STH CR14,0(CR12) STORE LENGTH IN BUFFER 12980000 BAL CR14,CWRT WRITE BUFFER 13000000 LR CR1,CR11 POINT TO BUFFER BEING WRITTEN NOW 13020000 C CR12,CTAR(CR11) IS THIS THE LOWER WK C BUFFER 13040000 BL CASF0 IF YES SKIP 13060000 L CR12,CTAR(CR11) ELSE POINT TO LOWER 13080000 CASF0 TM CTSWCH(CR1),CDWRT WAS A WRITE EVER ISSUED ON IT 13100000 BZ CASF1 IF NO DON'T CHECK IT 13120000 BAL CR14,CCHK ELSE ENSURE COMPLETION OF WRITE 13140000 CASF1 LR CR1,CR10 POINT TO OTHER DECB 13160000 BAL CR14,CCHK CHECK IT 13180000 MVC CTAR(4,CR10),CTAR(CR8) WK B BUFFER ADR TO WK C DECB 13200000 MVC CTAR(4,CR11),CTAR(CR9) WK B BUFFER ADR TO WK C DECB 13220000 BAL L1,COPEN GO INITIALIZE WK C BUFFER POINTERS 13240000 DC X'00002000' 13260000 LR CR1,CR12 POINT TO WK C BUFFER AREA 13280000 B CASF3 13300000 CASF2 L CR1,CTAR(CR8) LOAD ADR OF 1ST BUFFER 13320000 C CR1,CTAR(CR9) IS IT THE LOWER OF THE TWO 13340000 BL CASF3 IF YES O.K. 13360000 L CR1,CTAR(CR9) ELSE LOAD THE LOWER OF THE TWO 13380000 CASF3 LH CR0,CTSZ(CR9) LOAD THE LENGTH OF A WK B BUFFER 13400000 AR CR0,CR0 DOUBLE FOR TOTAL TO BE FREED 13420000 * FREEMAIN R,LV=(0),A=(1) FREE CORE USED BY WKB BUFFERS 13440000 FREEMAIN R,LV=(0),A=(1) FREE CORE USED BY WKB BUFFERS 13460000 * GETMAIN VU,LA=CPTAB,A=CCORAD 13480000 GETMAIN VU,LA=CPTAB,A=CCORAD 13500000 LM CR11,CR12,CCORAD LOAD ADR & SIZE OF EXTRA CORE 13520000 LR CR1,CR11 PREPARE TO FREE LOWER 600 BYTES FOR 13540000 LA CR0,4088 SPACE FOR END OF EXTENT ROUTINES 22075 13560019 AR CR11,0 BUMP POINTER TO EXTRA CORE 13580000 SR CR12,0 DUNK SIZE OF EXTRA CORE 13600000 STM CR11,CR12,CCORAD STORE ADR AND SIZE OF EXTRA CORE 13620000 STM CR11,CR12,UCTBADR(CR2) STORE INFO FOR LATER FREEMAIN 13640000 * FREEMAIN R,LV=(0),A=(1) FREE ENOUGH CORE FOR END OF EXTENT 13660000 FREEMAIN R,LV=(0),A=(1) FREE ENOUGH CORE FOR END OF EXTENT 13680000 .NFP AIF ('&PHASE' NE 'PD2').NFP2 13700000 MVC CPDSW(1),UCNCD(CR2) MOVE FLAGE SWITCH TO LOCAL BUCKET 13720000 .NFP2 AIF ('&PHASE' NE 'PMG' AND '&PHASE' NE 'SMG').GCOR2 13740000 L CR0,UCATAB(CR2) SIZE OF ATABL FROM BLD PHASE 13760000 ST CR0,UCTBSZ(CR2) STORE SIZE FOR FREEMAIN 13780000 * GETMAIN R,LV=(0) 13800000 GETMAIN R,LV=(0) 13820000 ST CR1,CCORAD 13840000 ST CR1,UCTBADR(CR2) 13860000 .GCOR2 AIF ('&PHASE'(1,2) NE 'AS' OR '&PHASE' EQ 'AS1' OR '&PHASE' C13880000 EQ 'ASP' OR '&PHASE' EQ 'ASW').DST1 13900000 MVC CCORAD(8),UCTBADR(CR2) GET TABLE CORE ADR & SIZE 13920000 AGO .SNTA 13940000 .DST1 AIF ('&PHASE' NE 'DST').SNTA 13960000 BAL L1,COPEN OPEN A AND B OUTPUT, C INPUT 13980000 DC X'00201000' (FILES B AND C HAVE BEEN SWITCHED) 14000000 .SNTA B &ENTRY 14020000 AIF (&XPH).XPH2 14040000 CNAME DC C'&PHASE' T NAME OF PHASE 14060000 CLNCT DC H'60' LINE COUNT - OVERLAID FROM COMM 14080000 CLNS DC H'1' 14100000 CDEBUG DC F'0' T ADR OF DEBUG ROUTINE STORED HERE 14120000 CCOMM DC F'0' ADR OF COMMON AREA STORED HERE 14140000 .XPH2 ANOP 14160000 CRSAVE DC 18F'0' SAVE AREA FOR CONTROL PROGRAM USE 14180000 AIF ('&PHASE' NE 'PG4').PG4 14200000 ROMAC SR C1,C1 14220000 IC C1,16(S1) PLACE DCB POINTER IN C1 14240000 MH C1,RCH03 MULTIPLY BY 3 14260000 SH C1,RCH03 SUBTRACT 3 14280000 LA C3,RDCBF(C1) C3 POINTS TO DCB ADDR 14300000 MVC DESTFD(3),0(C3) DCB ADDR TO DESTFD 14320000 MVI GLX,X'A0' ZERO FIRST BYTE 14340000 MVC GLX+1(2),21(S1) USER LABEL TO BUCKET 14360000 MVC SENDFD(3),RSPN1 14380000 MVC XFIELD(3),RSPN2 14400000 MVC YFIELD(3),RSPN3 14420000 MVC AAA(3),RSPN4 14440000 LH W1,RGENL 14460000 AH W1,RCH01 14480000 STH W1,RGENL 14500000 MVC GL2+1(2),RGENL 14520000 LA W1,R0538 POINT TO COMMON OVERFLOW STRING 14540000 BAL L1,INTER2 PUTOUT COMMON INSTRUCTIONS 14560000 TM 0(S1),X'02' IS CONDITION NOT-OVERFLOW 14580000 BZ ROMAC1 GO PUTOUT IS-OVERFLOW INSTRUCTIONS 14600000 LA W1,R0538A POINT TO NOT-OVERFLOW INSTRUCTIONS 14620000 BAL L1,INTER2 PUTOUT NOT-OVERFLOW INSTRUCTIONS 14640000 B RETRN RETURN TO PHASE 14660000 ROMAC1 LH W1,RGENL GET LAST LABEL USED 14680000 AH W1,RCH01 ADD ONE 14700000 STH W1,RGENL SAVE IT 14720000 MVC GL3+1(2),RGENL PUT IT IN GL3 14740000 LA W1,R0538B POINT TO IS-OVERFLOW INSTRUCTIONS 14760000 BAL L1,INTER2 PUTOUT IS-OVERFLOW INSTRCTIONS 14780000 B RETRN RETURN TO PHASE 14800000 R0538 DC AL2(L128-D) LA 2,DCB 14820000 DC AL2(L771-D) L 1,68(2) 14840000 DC AL2(L772-D) L 1,12(1) 14860000 DC AL2(L773-D) TM 0(1),X'40' 14880000 DC AL2(L306-D) BC 1,GL2 14900000 DC AL2(L791-D) LA 0,1 14920000 DC AL2(L636-D) SVC 1 14940000 DC AL2(L170-D) GL2 14960000 DC AL2(L774-D) TM 44(2),X'10' 14980000 DC H'0' END OF STRING 15000000 R0538A DC AL2(L775-D) BC 14,GLX 15020000 DC AL2(L776-D) NI 44(2),X'EF' 15040000 DC H'0' END OF STRING 15060000 R0538B DC AL2(L790-D) BC 14,GL3 15080000 DC AL2(L776-D) NI 44(2),X'EF' 15100000 DC AL2(L792-D) BC 15,GLX 15120000 DC AL2(L793-D) GL3 15140000 DC H'0' END OF STRING 15160000 .PG4 AIF ('&PHASE' NE 'PG9').PG9 15180000 IPTCALL DC AL2(L993-D) L 0,=V(IHD03300) 15200000 DC AL2(L996-D) ST 0,204(3) 15220000 DC H'0' 15240000 DRET DC AL2(L463-D) STM 3,10,324(3) 15260000 DC AL2(L601-D) 15280000 DC AL2(L600-D) 15300000 DC AL2(L536-D) 15320000 DC AL2(L477-D) 15340000 DC AL2(L474-D) 15360000 DC AL2(L521-D) 15380000 DC H'0' 15400000 .PG9 AIF ('&PHASE' NE 'ALC').ALC 15420000 ALC002 DC 0F'0' 15440000 HSHTBL DC 16H'0' HASH TABLER 15460000 DC X'0052' LOAD ADDRESS OF QUOTE 15480000 DC 34H'0' 15500000 DC X'0031' LOAD ADDRESS OF SPACE 15520000 DC 39H'0' 15540000 DC X'00C9' LOAD ADDRESS OF TALLY 15560000 DC 2H'0' 15580000 DC X'00B2' LOAD ADDR OF HIGH-VALUES AND LOW-VALS 15600000 DC 49H'0' 15620000 DC X'0062' LOAD ADDRESS OF QUOTES 15640000 DC 34H'0' 15660000 DC X'0041' LOAD ADDRESS OF SPACES 15680000 DC 29H'0' 15700000 DC X'0001' LOAD ADDRESS OF ZERO 15720000 DC 7H'0' 15740000 DC X'009E' LOAD ADDRESS OF LOW-VALUE 15760000 DC H'0' 15780000 DC X'0073' LOAD ADDRESS OF HIGH-VALUE 15800000 DC 4H'0' 15820000 DC X'0010' LOAD ADDRESS OF ZEROS 15840000 DC 16H'0' 15860000 DC X'0020' LOAD ADDRESS OF ZEROES 15880000 DC 12H'0' 15900000 .ALC AIF ('&PHASE' NE 'AS6').SCPR 15920000 CCORAD DC F'0' BUCKET FOR EXTRA CORE LOCATION 15940000 CCORSZ DC F'0' BUCKET FOR EXTRA CORE SIZE 15960000 CHEAD1 DC 42C' ' FIRST HEADING LINE FOR P-MAP 15980000 DC C'PROCEDURE DIVISION MAP' 16000000 DC 56C' ' 16020000 CHEAD2 DC 3C'LINE/POS ADDR INSTRUCTION ' 16040000 DC 9C' ' 16060000 .SCPR AIF ('&PHASE' NE 'AS4').SCPRX 16080000 DC 0F'0' 16100000 ENTRF01 DC X'D2' OUTPUT FOR INITIALIZIATION OS 16120000 DC AL3(ENTRF06-ENTRF01-4) 16140000 DC CL8' ' 16160000 ENTRF011 STM 14,12,12(13) SAVE 16180000 BALR 3,0 16200000 ENTRF02 LR 15,3 16220000 DC X'5B3F000A' POINT TO GLOBAL TABLE START 16240000 * THE PRECEDING INSTRUCTION SHOULD BE 16260000 * S 3,ENTRF03-ENTRF02(15) 16280000 * BUT WE WOULD GET AN ALIGNMENT DIAGNOSTIC 16300000 BC 15,ENTRF04-ENTRF02(15) 16320000 ENTRF03 DC AL4(ENTRF02-ENTRF011) ERT ENTRF02-STGT HERE 16340000 ENTRF04 LA 14,252(3) 16360000 ST 13,256(3) SAVE OLD SAVE AREA POINTER 16380000 ENTRF05 ST 14,8(13) 16400000 LR 13,14 SET UP NEW SAVE AREA POINTER 16420000 LM 3,12,324(3) INITALIZE REGISTER 16440000 LR 2,1 SAVE PARAMETER REGISTER 16460000 LA 1,204(3) 16480000 SVC 14 16500000 ST 1,200(3) 16520000 LR 1,2 RESTORE PARAMETER REGISTER 16540000 ENTRF06 STM 14,12,12(13) 16560000 ENTRF07 ST 14,8(13) 16580000 .SCPRX AIF ('&PHASE' NE 'BLD').SSHS 16600000 LTORG 16620000 CTAPB DC X'7FFF' MAXIMUM BLOCKSIZE FOR TAPE FILES 16640000 CHASH DC 502X'0' TEMP STORE AREA FOR HASH TABLE 16660000 DS 2800C PAD FOR GETMAIN, TO MAKE BLD EQ PMG 16680000 EJECT 16700000 IEPBLDA CSECT 16720000 DS 1650C PAD FOR GETMAIN TO MAKE BLD>PMG+SIS 7719 16740017 CCORDF DC F'1984' SIZE DIFFERENCE BETWEEN PMG/SMG 22075 16760019 CBCOR DC F'2506' SMALLEST SEG. SIZE + HTABL 16780000 DC F'0' UATBL + 4 + HTBL 16800000 CCORAD DC F'0' ADR OF EXTRA CORE 16820000 CCORSZ DC F'0' SIZE OF EXTRA CORE 16840000 .SSHS AIF ('&PHASE' NE 'PD1').PDG2 16860000 CWPDG1 DC 2F'0' BUCKET FOR INFO TO FREE WKA BUFFERS 16880000 .PDG2 AIF ('&PHASE' NE 'PD2').PDG3 16900000 CPDSW DC X'0' UCNCD IS MOVED TO THIS POS. 16920000 CPREF DC C'IEP' IDENTIFIER FOR E ON DIAG. NOS. 16940000 .PDG3 AIF ('&TC' EQ '' AND '&PHASE' NE 'AS1' AND '&PHASE' NE C16960000 'AS2' AND '&PHASE' NE 'AS3' AND '&PHASE' NE 'AS4').PART2 16980000 AGO .NOSCORF 17000000 .PART2 AIF ('&PHASE' NE 'AS5' AND '&PHASE'(2,2) NE 'MG' AND C17020000 '&PHASE' NE 'ASA').SCORF 17040000 .NOSCORF ANOP 17060000 CCORAD DC F'0' ADR OF EXTRA CORE 17080000 AIF ('&PHASE'(1,2) NE 'AS' AND '&TC' NE 'P').SCORF 17100000 CCORSZ DC F'0' SIZE OF EXTRA CORE 17120000 AIF ('&PHASE' NE 'AS1').NOSCRFA 1939 17126015 CPTAB DC F'4288' MINIMUM TABLE SIZE 22075 17132019 DC F'131000' UPPER LIMIT OF TABLE CORE GETMAIN 1939 17138015 AGO .SCORF 1939 17144015 .NOSCRFA AIF ('&TC' NE 'P').SCORF 1939 17150015 CPTAB DC F'1000' MINIMUM TABLE SIZE 17160000 DC F'64000' UPPER LIMIT OF TABLE CORE GETMAIN 17180000 .SCORF AIF (NOT &TRM).SCORP 17200000 CTERML DC A(CTERMN) POINTER TO MODULE NAME 17220000 DC A(0) NUL POINTER TO DCB 17240000 CTERMN DC C'IEPTRM00' 17260000 CTERM LA CR12,CTERMC LOAD UNIQUE EARLY TERMINATION CODE 17280000 L CR13,CRSAVE+4 POINT TO HIGHER LEVEL SAVE AREA 17300000 L CR14,12(CR13) RESTORE RETURN REGISTER 17320000 LA CR15,CTERML POINT TO ADCONS FOR XCTL MACRO 17340000 LM CR0,CR11,20(CR13) RESTORE OTHER REGISTERS 17360000 SVC 7 AND CALL EARLY TERMINATION MODULE 17380000 .SCORP AIF (&SKIPS GT 1).NTSL ASSUME BYPASSING PHASES ' '. 17400000 AIF ('&NEXT'(4,3) EQ ' ').SL 17420000 AIF ('&NEXT'(8,1) EQ 'N').RL 17440000 CLINKS MVC CPHLN+3(3),0(CR15) 17460000 .RL ANOP 17480000 CLINK LA CR15,CPHADR POINT TO MODULE NAME POINTER 17500000 AIF (&XPH).XPH3 17520000 LA CR13,CRSAVE POINT TO SAVE AREA 17540000 L CR2,CCOMM POINT TO COMM AREA FOR NEXT PHASE 17560000 .XPH3 AIF ('&PHASE' EQ 'CBL' OR '&PHASE' EQ 'SYS').NDEX 17580000 L CR9,UCDEBUG(CR2) T LOAD ADR OF DEBUG ROUTINE 17600000 ST L1,CRSAVE T STORE LINK REG 17620000 BALR L1,CR9 T GO TO EXIT ROUTINE 17640000 DC H'2' T INDICATES EXIT FROM PHASE 17660000 L L1,CRSAVE T RESTORE LINK REG 17680000 .NDEX SVC 6 LINK TO NEXT PHASE 17700000 BR L1 17720000 CPHLN DC CL8'IEP&NPH.00' 17740000 CPHADR DC A(CPHLN) 17760000 DC A(0) 17780000 .SL AIF ('&NEXT'(1,3) EQ ' ' OR '&NEXT'(8,1) EQ 'X').NTSL 17800000 AIF ('&NEXT'(8,1) EQ 'N').NTSL 17820000 CEXITS MVC CPHN01+3(3),0(CR15) 17840000 .NTSL AIF ('&PHASE' EQ 'CBL').SKY 17860000 CEXIT DC 0H'0' ROUTINE TO EXIT FROM PHASE 17880000 AIF ('&PHASE' NE 'BLD').NBLD 17900000 L CR2,CCOMM POINT TO COMMON AREA 17920000 MVC UCATAB(4,CR2),TBSZ STORE SIZE OF GETMAIN FOR PMG-SMG 17940000 .NBLD AIF ('&PHASE' NE 'ALC').SHSH 17960000 LM CR10,CR11,CWKA POINT TO WKA DECB'S 17980000 L CR9,CTAR(CR10) POINT TO BUFFER 1 FOR WKA 18000000 C CR9,CTAR(CR11) IS THIS THE LOWER 18020000 BL COKAY IF YES BR 18040000 L CR9,CTAR(CR11) ELSE LOAD ADR OF LOWER BUFFER 18060000 COKAY MVC 0(256,CR9),0(CR8) MOVE HASH TABLE TO BUFFER AREA 18080000 MVC 256(246,CR9),256(CR8) 18100000 ST CR9,CSAVE 18120000 L CR2,CCOMM POINT TO COMM AREA 18140000 MVC UHASH(3,CR2),CSAVE+1 NEW HASH TBL ADR TO COMM BKT 18160000 .SHSH AIF ('&SIO'(1,4) EQ ' ').REX 18180000 LA CR13,CRSAVE 18200000 AIF ('&PHASE'(1,2) EQ 'AS' AND '&PHASE' NE 'AS6').SE2 18220000 L CR1,CPCON+4 POINT TO LAST DECB WRITTEN 18240000 LTR CR1,CR1 WAS THIS DECB WRITTEN FROM 18260000 BM *+8 IF NOT DONT CHECK IT 18280000 BAL CR14,CCHK ASSURE ITS COMPLETION 18300000 AIF ('&PHASE' NE 'DS1' AND '&PHASE' NE 'DS2').SE1 18320000 L CR1,CCCON POINT TO LAST DECB READ FROM 18340000 L CR3,CTAR(CR1) POINT TO ITS BUFFER 18360000 BAL CR14,CCHK ENSURE ITS COMPLETION 18380000 L CR2,CCOMM POINT TO COMM AREA 18400000 MVC UPCRD(80,CR2),0(CR3) MOVE EXTRA CARD TO COMM FIELD 18420000 .SE1 AIF ('&PHASE' NE 'AS6').REX 18440000 .SE2 L CR1,CCCON LOAD ADD OF NEXT TO LAST DCB PNCHD FROM 17579 18446018 LTR CR1,CR1 WAS THIS DECB WRITTEN FROM 17579 18452018 BM *+8 IF NOT DONT CHECK IT 17579 18458018 BAL CR14,CCHK ELSE CHECK ITS COMPLETION 17579 18464018 L CR1,CCCON+4 LOAD ADDRESS OF LAST DECB PUNCHED FROM 17579 18470018 LTR CR1,CR1 WAS THIS DECB WRITTEN FROM 18480000 BM *+8 IF NOT DONT CHECK IT 18500000 BAL CR14,CCHK ELSE CHECK ITS COMPLETION 18520000 .REX AIF ('&FC' EQ '').NFC 18540000 LA CR13,CRSAVE 18560000 L CR2,CCOMM 18580000 L CR1,UCTBADR(CR2) 18600000 L CR0,UCTBSZ(CR2) LOAD SIZE OF CORE FOR FREEMAIN 18620000 * FREEMAIN R,LV=(0),A=(1) 18640000 FREEMAIN R,LV=(0),A=(1) 18660000 .FCOR1 AIF ('&PHASE' NE 'LST').FCOR2 18680000 * *** ROUTINE TO GET BUFFERS FOR WORK B *** 18700000 LM CR3,CR4,UCWKB(CR2) POINT TO WKB DECB'S 18720000 LH CR0,CTSZ(CR3) LOAD LENGTH OF ONE WKB BUFFER 18740000 AR CR0,CR0 DOUBLE FOR TOTAL NEEDED 18760000 * GETMAIN R,LV=(0) GET CORE FOR BUFFERS 18780000 GETMAIN R,LV=(0) GET CORE FOR BUFFERS 18800000 ST CR1,CTAR(CR3) STORE ADR IN 1ST DECB 18820000 AH CR1,CTSZ(CR3) BUMP BY LENGTH FOR ADR OF 2ND BUFFER 18840000 ST CR1,CTAR(CR4) STORE ADR IN 2ND DECB 18860000 .NFC AIF ('&TC' NE 'P').FCOR2 18880000 L CR0,CCORSZ 18900000 L CR1,CCORAD 18920000 LA CR13,CRSAVE 18940000 * FREEMAIN R,LV=(0),A=(1) 18960000 FREEMAIN R,LV=(0),A=(1) 18980000 .FCOR2 AIF ('&PHASE' NE 'PD1').FCOR3 19000000 CLI CL1+3,C'X' WAS ANY TABLE LOADED 19020000 BE CPEX1 IF NOT SKIP DELETE MACRO 19040000 * DELETE EPLOC=CL1 DELETE LAST TABLE USED 19060000 DELETE EPLOC=CL1 DELETE LAST TABLE USED 19080000 CPEX1 LM CR0,CR1,CWPDG1 LOAD INFO TO FREE WKA BUFFERS 19100000 LA CR13,CRSAVE 19120000 * FREEMAIN R,LV=(0),A=(1) 19140000 FREEMAIN R,LV=(0),A=(1) 19160000 .FCOR3 AIF ('&NEXT'(1,3) EQ ' ').SX 19180000 LA CR15,CPHAD1 POINT TO ADDRESS OF NEXT PHASE NAME 19200000 AIF (&XPH).SYSX 19220000 L CR2,CCOMM POINT TO COMMON AREA 19240000 LA CR13,CRSAVE T POINT TO SAVE AREA 19260000 .SYSX L CR9,UCDEBUG(CR2) T POINT TO DEBUG MODULE OR DUMMY 19280000 BALR L1,CR9 T GO CHECK EXIT FOR DEBUG 19300000 DC H'2' T INDICATES EXIT 19320000 AIF (&XPH).XPH4 19340000 MVC ULNCT(4,CR2),CLNCT SAVE LINE COUNT BUCKETS 19360000 .XPH4 AIF ('&CIOP'(1,1) EQ 'X').RE 19380000 MVC UCWKA(24,CR2),CWKX SAVE CURRENT WK FILE DECB POINTERS 19400000 .RE AIF ('&PHASE'(1,2) NE 'PS' OR '&PHASE' EQ 'PS4').FCOR4 19420000 CLI CPHN01+4,C'G' WAS NEXT PHASE CHANGED TO GENERATOR 19440000 BE CEXIT1 IF YES DON'T SWITCH WKB AND WKC 19460000 .FCOR4 AIF ('&PHASE'(1,2) NE 'PG' OR '&PHASE' EQ 'PG9').FCORX 19480000 CLI CPHN01+3,C'A' DID CEXITS SPECIFY EXIT TO AS0 19500000 BE CEXIT1 IF YES DON'T SWITCH WKB AND WKC 19520000 .FCORX AIF ('&PHASE'(1,2) NE 'PS' AND '&PHASE'(1,2) NE 'PG').FCOR5 19540000 AIF ('&PHASE' EQ 'PS4' OR '&PHASE' EQ 'PG9').FCOR5 19560000 XI UCSW(CR2),CXIFA ADD MOD 2 FOR INVERT. FILE ASSIGN. 19580000 LM CR8,CR11,UCWKB(CR2) LOAD WKB & C DECB POINTERS 19600000 STM CR10,CR11,UCWKB(CR2) STORE WKC POINTERS IN WKB POSITION 19620000 STM CR8,CR9,UCWKC(CR2) AND WKB POINTERS IN WKC POSITION 19640000 CEXIT1 EQU * 19660000 .FCOR5 AIF ('&PHASE' NE 'DST').SKIP4 19680000 BAL L1,CCLOSE 19700000 DC X'00020100' 19720000 .SKIP4 AIF (&SKIPS GT 1).SKIP6 19740000 &NEXT SETC '&LPH' 19760000 .SKIP5 ANOP 19780000 CIBYFT NEXT=&NEXT 19800000 AGO .EX 19820000 .SKIP6 CIBYFT NEXT=&SKIPPH 19840000 AGO .EX 19860000 .SX AIF (&XPH).XPH5 19880000 LA CR13,CRSAVE T POINT TO SAVE AREA 19900000 L CR9,CDEBUG T LOAD ADR OF DEBUG MODULE 19920000 BALR L1,CR9 T GO TO DEBUG MODULE OR DUMMY 19940000 DC H'4' T INDICATES RETURN TYPE EXIT 19960000 L CR2,CCOMM POINT TO COMM AREA 19980000 MVC ULNCT(4,CR2),CLNCT STORE LINE COUNT 20000000 .XPH5 L CR13,CRSAVE+4 RESTORE REG 13 20020000 LM CR14,CR12,12(CR13) RESTORE OTHER REGS 20040000 BR CR14 RETURN TO LOWER PHASE 20060000 .EX AIF ('&PHASE' NE 'DS1').DS1 20080000 CPUTA DC 0H'0' 20100000 CPUTB DC 0H'0' 20120000 AGO .SPAB 20140000 .DS1 AIF ('&PHASE' EQ 'PD1').PUTP 20160000 AIF ('&PHASE' EQ 'ASA').PUTP 20180000 AIF ('&CIOP'(1,1) EQ 'X').SC 20200000 AIF ('&CIOP'(1,1) EQ 'N').SAP 20220000 AIF ('&CIOP'(1,1) EQ ' ').SPA 20240000 CPUTA MVI CWK+1,CWKA-CWKX LOCATE FILE A DECB ADCONS 20260000 MVI CDP,C'A' T FLAG FILE A ON I/O TRACE 20280000 AIF ('&CIOP'(2,1) NE 'B').SPB 20300000 B CPUT GO TO COMMON PUT ROUTINE 20320000 .SPA AIF ('&CIOP'(2,1) NE 'B').SPAB 20340000 CPUTB MVI CWK+1,CWKB-CWKX LOCATE FILE B DECB ADCONS 20360000 MVI CDP,C'B' T FLAG FILE B ON I/O TRACE 20380000 .SPB AIF ('&CIOP'(3,1) NE 'C').SPC 20400000 B CPUT GO TO COMMON PUT ROUTINE 20420000 .SPAB AIF ('&CIOP'(3,1) NE 'C').SPC 20440000 CPUTC MVI CWK+1,CWKC-CWKX LOCATE FILE C DECB ADCONS 20460000 MVI CDP,C'C' T FLAG FILE B ON I/O TRACE 20480000 .SPC ANOP 20500000 CPUT STM CR13,CR3,CSAVE STORE REGS IN PRIVATE AREA 20520000 MVI CPD2,C'O' T INDICATE OUTPUT RECORD TO TRACE 20540000 * *CCLOSE ASSUMES THAT CPUT USES 20560000 * ONLY THESE REGS, , IF THIS IS 20580000 * CHANGED CCLOSE MUST BE FIXED. 20600000 LR CR2,OUTREG CR2 POINTS TO RECORD 20620000 LH CR3,CWK CR3 + CWKX LOCATES DECB ADCONS 20640000 .PUTP ANOP 20660000 CPUT0 L CR1,CWKX(CR3) *CR1 POINTS TO DECB OF BUFFER 20680000 * WHICH IS BEING FILLED. THIS IS 20700000 * THE ENTRY POINT FROM CCLOSE, 20720000 * AND ANY CHANGES TO REGISTER 20740000 * STATUS AT THIS POINT MUST BE 20760000 * MADE IN CCLOSE ALSO. 20780000 CPUT1 SR CR15,CR15 20800000 IC CR15,3(CR2) CR15 HAS LENGTH - 4 20820000 CPUT2 L CR14,CTPT(CR1) CR14 HAS CURRENT POS IN BUFFER 20840000 LA CR13,4(CR14,CR15) 20860000 C CR13,CTLX(CR1) COMP TO LAST POS IN BUFFER + 1 20880000 BH CPUT3 IF HI GO WRITE CURRENT CONTENTS 20900000 ST CR13,CTPT(CR1) ELSE STORE NEXT POS 20920000 LA CR15,3(CR15) CR15 HAS LENGTH OF RECORD - 1 20940000 EX CR15,CMV MOVE RECORD TO BUFFER 20960000 ST CR14,CDGWK STORE LOCATION 20980000 BAL CR14,CDRP2 T GO TRACE 21000000 CPUT5 LM CR13,CR3,CSAVE *RESTORE REGS. IN CCLOSE THIS 21020000 * INSTRUCTION IS REPLACED BY EXIT 21040000 BR L1 AND EXIT 21060000 CMV MVC 0(0,CR14),0(CR2) 21080000 CPUT3 L CR13,CTAR(CR1) LOAD POINTER TO BUFFER 21100000 SR CR14,CR13 CALC ACTUAL LENGTH FOR WRITE 21120000 STH CR14,CTLT(CR1) STORE IN LENGTH FIELD OF DECB 21140000 STH CR14,0(CR13) AND STORE IN BUFFER 21160000 CPUT4 LA CR13,CRSAVE POINT CR13 TO PHASE SAVE AREA 21180000 OI CTSWCH(CR1),CDWRT INDICATE BUFFER WAS WRITTEN 21200000 BAL CR14,CWRT GO TO COMMON WRITE-READ LINKAGE 21220000 LA CR1,CWKX(CR3) 21240000 LM CR0,CR1,0(CR1) 21260000 * AND CR1 HAS ADR OF DECB TO FILL NEXT. 21280000 ST CR0,CWKX+4(CR3) SWITCH ADCONS 21300000 ST CR1,CWKX(CR3) 21320000 TM CTSWCH(CR1),CDWRT WAS BUFFER WRITTEN YET 21340000 BZ CPUT6 IF NOT SKIP PAST CHECK MACRO 21360000 BAL CR14,CCHK GO TO COMMON CHECK LINKAGE 21380000 CPUT6 L CR1,CWKX(CR3) 21400000 L CR14,CTAR(CR1) CR14 HAS BUFFER ADR 21420000 LA CR14,4(CR14) BUMP TO FIRST RECORD POS 21440000 ST CR14,CTPT(CR1) STORE IN TABLE 21460000 B CPUT1 21480000 .SAP AIF ('&CIOP'(4,1) EQ 'N').SAG 21500000 AIF ('&CIOP'(4,1) NE 'A').SGA 21520000 CGETA MVI CWK+1,CWKA-CWKX LOCATE FILE A DECB ADCONS 21540000 MVI CDP,C'A' T FLAG FILE A ON I/O TRACE 21560000 AIF ('&CIOP'(5,1) NE 'B').SGB 21580000 B CGET GO TO COMMON GET ROUTINE 21600000 .SGA AIF ('&CIOP'(5,1) NE 'B').SGAB 21620000 CGETB MVI CWK+1,CWKB-CWKX LOCATE FILE B DECB ADCONS 21640000 MVI CDP,C'B' T FLAG FILE B ON I/O TRACE 21660000 .SGB AIF ('&CIOP'(6,1) NE 'C').SGC 21680000 B CGET GO TO COMMON GET ROUTINE 21700000 .SGAB AIF ('&CIOP'(6,1) NE 'C').SGC 21720000 CGETC MVI CWK+1,CWKC-CWKX LOCATE FILE C DECB ADCONS 21740000 MVI CDP,C'C' T FLAG FILE C ON I/O TRACE 21760000 .SGC ANOP 21780000 CGET STM CR13,CR3,CSAVE STORE REGS IN PRIVATE AREA 21800000 MVI CPD2,C'I' T INDICATE INPUT RECORD TO TRACE 21820000 LH CR3,CWK CR3 LOCATES DECB ADCONS 21840000 L CR1,CWKX(CR3) CR1 HAS DECB ADR 21860000 L CR2,CTPT(CR1) CR2 HAS CURRENT RECORD ADR 21880000 C CR2,CTLX(CR1) IS THIS OUT OF BUFFER 21900000 BNL CGET3 IF YES GO READ NEW BUFFER 21920000 CGET1 CLC CEOF(8),0(CR2) IS THIS AN END OF FILE MARKER 21940000 BE CGETF IF YES EXIT 21960000 SR CR15,CR15 21980000 IC CR15,3(CR2) CR15 HAS LENGTH - 4 22000000 LA CR14,4(CR2,CR15) CR15 HAS NEXT POS IN BUFFER 22020000 ST CR14,CTPT(CR1) STORE IN POINTER SAVE AREA 22040000 ST CR2,CRSAVE STORE POINTER TO RECORD 22060000 BAL CR14,CDRP2 T GO TRACE 22080000 CGET2 LM CR13,CR3,CSAVE 22100000 L INREG,CRSAVE LOAD INREG WITH RECORD LOCATION 22120000 BR L1 22140000 CGET3 LA CR13,CRSAVE POINT TO PHASES SAVE AREA 22160000 BAL CR14,CWRT GO TO COMMON WRITE-READ LINKAGE 22180000 LA CR1,CWKX(CR3) 22200000 LM CR0,CR1,0(CR1) 22220000 * CR1 HAS ADR OF DECB TO BE DEBLOCKED NEXT 22240000 ST CR1,CWKX(CR3) SWITCH ADCONS 22260000 ST CR0,CWKX+4(CR3) 22280000 BAL CR14,CCHK GO TO COMMON CHECK LINKAGE 22300000 L CR1,CWKX(CR3) REPOINT CR1 TO DECB OF 22320000 * NEXT BUFFER TO BE DEBLOCKED 22340000 L CR2,CTAR(CR1) CR2 HAS BUFFER ADR 22360000 LH CR14,0(CR2) CR15 HAS LENGTH OF BUFFER 22380000 LA CR15,0(CR2,CR14) CR15 HAS END OF BUFFER +1 22400000 ST CR15,CTLX(CR1) STORE IN TABLE 22420000 CGET4 LA CR2,4(CR2) CR2 HAS ADR OF FIRST RECORD 22440000 B CGET1 22460000 CGETF LM CR13,CR3,CSAVE RESTORE REGS 22480000 B &EOFWK BR TO EOF ENTRY POINT 22500000 .SAG ANOP 22520000 CDRP2 STM CR8,CR10,CDRSAV T STORE REGS 22540000 L CR9,CDEBUG T LOAD ADR OF DEBUG ROUTINE 22560000 LA CR10,CDP T POINT TO PARM FOR IOTRACE 22580000 LA CR13,CRSAVE T POINT TO SAVE AREA 22600000 BALR L1,CR9 T CR2 POINTS TO RECORD 22620000 DC H'3' T INDICATES RECORD TRACE 22640000 LM CR8,CR10,CDRSAV T RESTORE REGS 22660000 BR CR14 T RETURN 22680000 CDP DC C' ' T NAME OF FILE PUT HERE FOR TRACE 22700000 CPD2 DC C' ' T I FOR INPUT , O FOR OUTPUT 22720000 CDRSAV DC 3F'0' T SAVE AREA FOR IOTRACE 22740000 AIF ('&SIO'(5,1) NE 'O').SO 22760000 * OPEN 22780000 * 22800000 * CALLING SEQUENCE --- 22820000 * BAL L1,COPEN 22840000 * DC X'T0' OPTION FOR FILE A 22860000 * DC X'T0' OPTION FOR FILE B 22880000 * DC X'T0' OPTION FOR FILE C 22900000 * 22920000 * T = 1 IF FILE IS TO BE INITIALIZED FOR INPUT 22940000 * T = 2 IF FILE IS TO BE INITIALIZED FOR OUTPUT 22960000 * T = 0 IF FILE IS NOT TO BE USED 22980000 * LOW ORDER FOUR BITS SHOULD BE ZERO - THEY ARE RESERVED FOR 23000000 * LATER USES. 23020000 * 23040000 * ACTION --- 23060000 * 1. POINTERS TO DECBS ARE RETRIEVED FROM COMM. REGION 23080000 * 2. TYPE CODES IN DECBS ARE SET TO READ OR WRITE 23100000 * 3. POINTER TO CURRENT POS IN BUFFER IS INITIALIZED 23120000 * 4. POINTER TO LAST POSITION OF BUFFER+1 IS SET 23140000 * 5. BUFFERS ARE FILLED IF INPUT 23160000 COPEN STM CR12,CR4,CSAVE STORE REGS IN PRIVATE AREA 23180000 LA CR4,CWKA CR4 POINTS TO FILE A ADCONS 23200000 LA CR12,3 CR12 COUNTS LOOP ON FILE PARAMS 23220000 COPEN1 TM 0(L1),X'30' IS FILE TO BE USED 23240000 BZ COPEN4 23260000 LA CR13,CRSAVE CR13 POINTS TO PHASE SAVE AREA 23280000 LA CR3,2 CR3 COUNTS LOOP ON DECB S 23300000 L CR1,4(CR4) CR1 POINTS TO 2ND DECB FOR FILE 23320000 COPEN2 L CR2,CTAR(CR1) CR2 HAS ADR OF BUFFER 23340000 LA CR0,4(CR2) BUMP PAST COUNT FLD TO ADR 23360000 * OF FIRST RECORD 23380000 ST CR0,CTPT(CR1) STORE IN POINTER FIELD 23400000 AH CR2,CTSZ(CR1) ADD LENGTH OF BUFFER MINUS 4 23420000 * TO GIVE LIMIT OF BUFFER 23440000 ST CR2,CTLX(CR1) STORE IN LIMIT FIELD 23460000 NI CTSWCH(CR1),255-CDWRT REMOVE FLAG FOR WRITE ON BUF 23480000 MVI CTTP(CR1),X'0' WIPE OUT TYPE BYTE 23500000 MVI CTTP+1(CR1),X'20' FLAG DECB FOR WRITE. OVERRIDE 23520000 * LATER IF SHOULD BE READ 23540000 L CR1,0(CR4) CR1 POINTS TO 1ST DECB OF FILE 23560000 BCT CR3,COPEN2 LOOP TO HANDLE 1ST DECB 23580000 AIF ('&CIOP'(4,1) EQ 'N' AND '&PHASE' NE 'ASA').SOR1 23600000 TM 0(L1),X'10' IS THE FILE AN INPUT FILE 23620000 BZ COPEN4 IF NOT, HANDLE NEXT FILE 23640000 LA CR3,2 CR3 COUNTS LOOP ON DECBS AGAIN 23660000 COPEN3 MVI CTTP+1(CR1),X'80' SET TYPE CODE FOR READ 23680000 MVI CTTP(CR1),X'80' SET U FORMAT TYPE CODE 23700000 BAL CR14,CWRT GO TO COMMON WRITE-READ LINKAGE 23720000 L CR1,4(CR4) POINT TO 2ND BUFFERS DECB 23740000 BCT CR3,COPEN3 LOOP TO FILL 2ND BUFFER 23760000 L CR1,0(CR4) POINT TO DECB FOR 1ST BUFFER 23780000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 23800000 L CR1,0(CR4) 23820000 L CR2,CTAR(CR1) CR2 HAS ADR OF BUFFER 23840000 AH CR2,0(CR2) ADD ACTUAL LENGTH FROM COUNT 23860000 ST CR2,CTLX(CR1) STORE IN LIMIT FIELD 23880000 .SOR1 ANOP 23900000 COPEN4 LA CR4,8(CR4) POINT TO ADCONS FOR NEXT FILE 23920000 LA L1,1(L1) BUMP POINTER TO PARAMS 23940000 BCT CR12,COPEN1 LOOP FOR ALL FILE PARAMS 23960000 LM CR12,CR4,CSAVE RESTORE REGS FROM PRIVATE AREA 23980000 DC X'47F80001' B 1(L1) AVOID WARNING DIAG. 24000000 .SO AIF ('&SIO'(6,1) EQ ' ').C999 24020000 AIF ('&SIO'(6,1) NE '2' AND '&SIO'(6,1) NE '6' AND C24040000 '&SIO'(6,1) NE '4').C124 24060000 * CCLOSE FOR TYPES TWO AND FOUR 24080000 CCLOSE STM CR13,CR4,CSAVE 24100000 LA CR4,3 *CR4 COUNTS LOOP-MUST BE REG NOT 24120000 * * USED BY CPUT 24140000 LA CR3,0 *CR3 INDEXES CWKX- MUST BE SAME 24160000 * * REG USED FOR THIS BY CPUT 24180000 MVC CPUT5(4),CCLBR1 *SET RETURN FROM CPUT BEFORE 24200000 * * REGS ARE RESTORED. DONT USE L1 24220000 CCLOS1 TM 0(L1),X'2' IS OUTPUT FILE TO BE CLOSED 24240000 BZ CCLOS4 IF NO CHECK NEXT PARAMETER 24260000 LA CR2,CEOF *POINT TO EOF RECORD WITH SAME 24280000 B CPUT0 *PUT EOF RECORD, USING ENTRY PT 24300000 * * AFTER REGS ARE SAVED. 24320000 * *ASSUME CR1 GETS DECB ADR IN 24340000 * * CPUT ROUTINE. 24360000 CCLOS2 L CR14,CTPT(CR1) CR14 GETS POINTER TO NEXT POS 24380000 L CR15,CTAR(CR1) CR15 GETS BUFFER ADR 24400000 SR CR14,CR15 CALC LENGTH OF ACTUAL BUFFER 24420000 STH CR14,0(CR15) STORE ACTUAL LENGTH IN BUFFE 24440000 STH CR14,CTLT(CR1) 24460000 * * REG USED FOR POINTER BY CPUT 24480000 LA CR13,CRSAVE POINT CR13 TO SAVE AREA 24500000 L CR2,CWKX+4(CR3) 24520000 TM CTSWCH(CR2),CDWRT WAS OTHER BUFFER EVER WRITTEN 24540000 BO CCLOS2A IF YES RETURN 24560000 LA CR15,100 PREPARE TO WRITE EXTRA RECORD 24580000 STH CR15,CTLT(CR2) TO POINT TO AND FOR READ-AHEAD 24600000 BAL CR14,CWRT GO TO COMMON ROUTINE TO WRITE 24620000 B CCLOS2B GO FINISH BUFFER FLUSHING 24640000 CCLOS2A BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 24660000 L CR1,CWKX+4(CR3) CR1 HAS ADR OF 2ND DECB 24680000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 24700000 CCLOS2B L CR1,CWKX+4(CR3) CR1 GETS ADR OF 2ND DECB 24720000 BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 24740000 L CR1,CWKX(CR3) CR1 GETS ADR 1ST DECB 24760000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 24780000 L CR1,CWKX+4(CR3) CR1 GETS ADR 2ND DECB 24800000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 24820000 CCLOS3 LA CR13,CRSAVE 24840000 L CR1,CWKX+4(CR3) CR1 HAS ADR OF DECB 24860000 L CR1,CTDCB(CR1) CR1 HAS ADR OF DCB 24880000 LR CR0,CR1 CR0 HAS ADR OF DCB 24900000 SH CR0,CON4 DUNK-NOTEWORD IS IN WORD BEFORE DCB 24920000 POINT (1),(0) 24940000 B CCLOS5 24960000 CCLOS4 TM 0(L1),X'4' IS THIS A TYPE 4 CLOSE 24980000 BO CCLOS3 IF YES GO REPOSITION 25000000 CCLOS5 LA CR3,8(CR3) BUMP TO INDEX CWKX 25020000 LA L1,1(L1) L1 POINTS TO PARAM FOR NXT FILE 25040000 BCT CR4,CCLOS1 LOOP FOR NEXT FILE 25060000 LM CR13,CR4,CSAVE 25080000 DC X'47F80001' B 1(L1) AVOID WARNING DIAG. 25100000 CCLBR1 B CCLOS2 *EARLY RETURN FROM CPUT SWITCH 25120000 AGO .C999 25140000 .C124 AIF ('&SIO'(6,1) NE '3' AND '&SIO'(6,1) NE '7').C14 25160000 * CCLOSE FOR TYPES ONE, TWO AND FOUR 25180000 CCLOSE STM CR13,CR4,CSAVE 25200000 LA CR4,3 *CR4 COUNTS LOOP-MUST BE REG NOT 25220000 * * USED BY CPUT 25240000 SR CR3,CR3 *CR3 INDEXES CWKX- MUST BE SAME 25260000 * * REG USED FOR THIS BY CPUT 25280000 MVC CPUT5(4),CCLBR1 *SET RETURN FROM CPUT BEFORE 25300000 * * REGS ARE RESTORED. DONT USE L1 25320000 CCLOS1 TM 0(L1),X'2' IS OUTPUT FILE TO BE CLOSED 25340000 BZ CCLOS5 IF NO CHECK FOR INPUT FILE REPOS. 25360000 LA CR2,CEOF *POINT TO EOF RECORD WITH SAME 25380000 B CPUT0 *PUT EOF RECORD, USING ENTRY PT 25400000 * * AFTER REGS ARE SAVED. 25420000 * *ASSUME CR1 GETS DECB ADR IN 25440000 * * CPUT ROUTINE. 25460000 CCLOS2 L CR14,CTPT(CR1) CR14 GETS POINTER TO NEXT POS 25480000 L CR15,CTAR(CR1) CR15 GETS BUFFER ADR 25500000 SR CR14,CR15 CALC LENGTH OF ACTUAL BUFFER 25520000 STH CR14,0(CR15) STORE ACTUAL LENGTH IN BUFFE 25540000 STH CR14,CTLT(CR1) 25560000 * * REG USED FOR POINTER BY CPUT 25580000 LA CR13,CRSAVE POINT CR13 TO SAVE AREA 25600000 L CR2,CWKX+4(CR3) CR2 POINTS TO OTHER DECB 25620000 TM CTSWCH(CR2),CDWRT WAS OTHER BUFFER WRITTEN 25640000 BO CCLOS2A IF YES BR 25660000 LA CR15,100 ELSE PREPARE DUMMY RECORD 25680000 STH CR15,CTLT(CR2) FOR READ AHEAD 25700000 BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 25720000 B CCLOS2B SKIP OVER CHECK ON OTHER BUFFER 25740000 CCLOS2A BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 25760000 L CR1,CWKX+4(CR3) CR1 HAS ADR OF 2ND DECB 25780000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 25800000 CCLOS2B L CR1,CWKX+4(CR3) CR1 GETS ADR OF 2ND DECB 25820000 BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 25840000 L CR1,CWKX(CR3) CR1 GETS ADR 1ST DECB 25860000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 25880000 L CR1,CWKX+4(CR3) CR1 GETS ADR 2ND DECB 25900000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 25920000 CCLOS3 L CR1,CWKX+4(CR3) CR1 HAS ADR OF DECB 25940000 L CR1,CTDCB(CR1) CR1 HAS ADR OF DCB 25960000 LR CR0,CR1 CR0 HAS ADR OF DCB 25980000 SH CR0,CON4 DUNK-NOTEWORD IS IN WORD BEFORE DCB 26000000 * POINT (1),(0) REPOSITION FILE 26020000 POINT (1),(0) 26040000 CCLOS4 LA CR3,8(CR3) CR3 INDEXES DECB'S FOR NEXT 26060000 LA L1,1(L1) L1 POINTS TO PARAM FOR NXT FILE 26080000 BCT CR4,CCLOS1 LOOP FOR NEXT FILE 26100000 MVC CPUT5(4),CCLBR2 RESTORE CPUT5 INSTRUCTION 26120000 LM CR13,CR4,CSAVE 26140000 DC X'47F80001' B 1(L1) AVOID WARNING DIAG. 26160000 CCLOS5 TM 0(L1),X'5' IS THIS TYPE 1 OR TYPE 4 CLOSE 26180000 BZ CCLOS4 IF NO CHECK NEXT PARAMETER 26200000 LA CR13,CRSAVE 26220000 TM 0(L1),X'4' IS THIS A TYPE 4 CLOSE 26240000 BO CCLOS3 IF YES GO REPOSITION FILE 26260000 L CR1,CWKX+4(CR3) POINT TO DECB BEING READ WITH 26280000 BAL CR14,CCHK CHECK ITS COMPLETION 26300000 B CCLOS3 26320000 CCLBR1 B CCLOS2 *EARLY RETURN FROM CPUT SWITCH 26340000 CCLBR2 LM CR13,CR3,CSAVE RESTORE CPUT5 26360000 AGO .C999 26380000 .C14 AIF ('&SIO'(6,1) NE '5' AND '&SIO'(6,1) NE '1').C1234 26400000 * CCLOSE FOR TYPES ONE AND FOUR 26420000 CCLOSE STM CR13,CR4,CSAVE 26440000 LA CR4,3 *CR4 COUNTS LOOP-MUST BE REG NOT 26460000 * * USED BY CPUT 26480000 SR CR3,CR3 *CR3 INDEXES CWKX- MUST BE SAME 26500000 * * REG USED FOR THIS BY CPUT 26520000 CCLOS1 TM 0(L1),X'5' IS THIS TYPE 1 OR TYPE 4 CLOSE 26540000 BZ CCLOS4 IF NO CHECK NEXT PARAMETER 26560000 LA CR13,CRSAVE 26580000 TM 0(L1),X'4' IS THIS A TYPE 4 CLOSE 26600000 BO CCLOS3 IF YES GO REPOSITION FILE 26620000 L CR1,CWKX+4(CR3) POINT TO DECB BEING READ WITH 26640000 BAL CR14,CCHK CHECK ITS COMPLETION 26660000 CCLOS3 L CR1,CWKX+4(CR3) CR1 HAS ADR OF DECB 26680000 L CR1,CTDCB(CR1) CR1 HAS ADR OF DCB 26700000 LR CR0,CR1 CR0 HAS ADR OF DCB 26720000 SH CR0,CON4 DUNK-NOTEWORD IS IN WORD BEFORE DCB 26740000 * POINT (1),(0) 26760000 POINT (1),(0) 26780000 CCLOS4 LA CR3,8(CR3) CR3 INDEXES DECB'S FOR NEXT 26800000 LA L1,1(L1) L1 POINTS TO PARAM FOR NXT FILE 26820000 BCT CR4,CCLOS1 LOOP FOR NEXT FILE 26840000 LM CR13,CR4,CSAVE 26860000 DC X'47F80001' B 1(L1) AVOID WARNING DIAG. 26880000 AGO .C999 26900000 .C1234 ANOP 26920000 * CCLOSE FOR TYPES ONE, TWO, THREE, AND FOUR 26940000 CCLOSE STM CR13,CR4,CSAVE 26960000 LA CR4,3 *CR4 COUNTS LOOP-MUST BE REG NOT 26980000 * * USED BY CPUT 27000000 SR CR3,CR3 *CR3 INDEXES CWKX- MUST BE SAME 27020000 * * REG USED FOR THIS BY CPUT 27040000 MVC CPUT5(4),CCLBR1 *SET RETURN FROM CPUT BEFORE 27060000 * * REGS ARE RESTORED. DONT USE L1 27080000 CCLOS1 TM 0(L1),X'2' IS OUTPUT FILE TO BE CLOSED 27100000 BZ CCLOS5 IF NO CHECK FOR INPUT FILE REPOS. 27120000 L CR1,CWKX(CR3) 27140000 CCLOS1A LA CR2,CEOF *POINT TO EOF RECORD WITH SAME 27160000 B CPUT0 *PUT EOF RECORD, USING ENTRY PT 27180000 * * AFTER REGS ARE SAVED. 27200000 * *ASSUME CR1 GETS DECB ADR IN 27220000 * * CPUT ROUTINE. 27240000 CCLOS2 L CR14,CTPT(CR1) CR14 GETS POINTER TO NEXT POS 27260000 L CR15,CTAR(CR1) CR15 GETS BUFFER ADR 27280000 SR CR14,CR15 CALC LENGTH OF ACTUAL BUFFER 27300000 STH CR14,0(CR15) STORE ACTUAL LENGTH IN BUFFER 27320000 STH CR14,CTLT(CR1) 27340000 * * REG USED FOR POINTER BY CPUT 27360000 LA CR13,CRSAVE POINT CR13 TO SAVE AREA 27380000 L CR2,CWKX+4(CR3) CR2 POINTS TO OTHER DECB 27400000 TM CTSWCH(CR2),CDWRT WAS OTHER BUFFER EVER WRITTEN 27420000 BO CCLOS2A IF YES RETURN 27440000 LA CR15,100 PREPARE TO WRITE EXTRA RECORD 27460000 STH CR15,CTLT(CR2) TO POINT TO AND FOR READ-AHEAD 27480000 BAL CR14,CWRT GO TO COMMON ROUTINE TO WRITE 27500000 B CCLOS2B GO FINISH BUFFER FLUSHING 27520000 CCLOS2A BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 27540000 L CR1,CWKX+4(CR3) CR1 HAS ADR OF 2ND DECB 27560000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 27580000 CCLOS2B L CR1,CWKX+4(CR3) CR1 GETS ADR OF 2ND DECB 27600000 BAL CR14,CWRT GO TO COMMON WRITE ROUTINE 27620000 L CR1,CWKX(CR3) CR1 GETS ADR 1ST DECB 27640000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 27660000 L CR1,CWKX+4(CR3) CR1 GETS ADR 2ND DECB 27680000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE 27700000 TM 0(L1),X'1' IS THIS A TYPE 3 CCLOSE 27720000 BZ CCLOS3 IF NO DONT REPOSITION 27740000 L CR2,CCOMM 27760000 L CR1,UCDCBA(CR2) 27780000 * NOTE (1) 27800000 NOTE (1) 27820000 ST CR1,UCREP(CR2) 27840000 CCLOS3 L CR1,CWKX+4(CR3) CR1 HAS ADR OF DECB 27860000 L CR1,CTDCB(CR1) CR1 HAS ADR OF DCB 27880000 LR CR0,CR1 CR0 HAS ADR OF DCB 27900000 SH CR0,CON4 DUNK-NOTEWORD IS IN WORD BEFORE DCB 27920000 * POINT (1),(0) 27940000 POINT (1),(0) 27960000 CCLOS4 LA CR3,8(CR3) CR3 INDEXES DECB'S FOR NEXT 27980000 LA L1,1(L1) L1 POINTS TO PARAM FOR NXT FILE 28000000 BCT CR4,CCLOS1 LOOP FOR NEXT FILE 28020000 MVC CPUT5(4),CCLBR2 28040000 LM CR13,CR4,CSAVE 28060000 DC X'47F80001' B 1(L1) AVOID WARNING DIAG. 28080000 CCLOS5 TM 0(L1),X'5' IS THIS TYPE 1 OR TYPE 4 CLOSE 28100000 BZ CCLOS4 IF NO CHECK NEXT PARAMETER 28120000 LA CR13,CRSAVE 28140000 TM 0(L1),X'4' IS THIS A TYPE 4 CLOSE 28160000 BO CCLOS3 IF YES GO REPOSITION FILE 28180000 L CR1,CWKX+4(CR3) POINT TO DECB BEING READ WITH 28200000 BAL CR14,CCHK CHECK ITS COMPLETION 28220000 B CCLOS3 28240000 CCLBR1 B CCLOS2 *EARLY RETURN FROM CPUT SWITCH 28260000 CCLBR2 LM CR13,CR3,CSAVE 28280000 .C999 AIF ('&PHASE'(1,2) NE 'PG').SREP 28300000 AIF ('&PHASE'(3,1) EQ '4' OR '&PHASE'(3,1) EQ '5' OR C28320000 '&PHASE'(3,1) EQ '7').SREP 28340000 CREP STM CR13,CR1,CSAVE STORE REGS IN PRIVATE AREA 28360000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 28380000 L CR1,CWKA+4 LOAD ADR OF DECB BEING READ 28400000 BAL CR14,CCHK ENSURE COMPLETION OF OPERATION 28420000 MVI CEND+3,C'F' RESTORE END FLAG TO 1EOF 28440000 L CR14,CCOMM POINT CR14 TO COMM AREA 28460000 LA CR0,UCREP(CR14) POINT CR0 TO NOTEWORD 28480000 L CR1,UCDCBA(CR14) LOAD ADR OF WKA DCB 28500000 * POINT (1),(0) POINT TO CONTINUE WRITING 28520000 POINT (1),(0) POINT TO CONTINUE WRITING 28540000 ST L1,CRSAVE SAVE LINK REGISTER 28560000 LM CR13,CR1,CSAVE RESTORE REGS SINCE COPEN SAVES THEM 28580000 BAL L1,COPEN SET UP FILE FOR CPUTA 28600000 DC X'20000000' 28620000 L L1,CRSAVE 28640000 BR L1 28660000 .SREP AIF ('&CIOP'(7,1) EQ 'N' OR '&CIOP'(1,1) EQ 'X').SCD 28680000 &D SETC '&CIOP'(8,1) 28700000 AIF ('&PHASE' EQ 'PMG').NDGQ 28720000 AIF ('&PHASE' EQ 'SMG').NDGQ 28740000 AIF ('&CIOP'(7,1) NE 'V').SDGR 28760000 AIF ('&PHASE' NE 'DS1').DS11 28780000 CVDAGA DC 0H'0' 28800000 .DS11 ANOP 28820000 CVDAG&D STM CR0,CR1,CDGSAV ENTRY POINT 28840000 ST OUTREG,CDGSS2 SAVE OUTREG 28860000 BAL 1,CDG7 GET NYYY IN REG 0 28880000 AGO .SDGB 28900000 .SDGR ANOP 28920000 CDIAG&D STM CR0,CR1,CDGSAV 28940000 ST OUTREG,CDGSS2 SAVE OUTREG 28960000 LH 0,0(L1) NYYY TO REG 0 28980000 LA L1,2(L1) POINT TO NEXT PARAMETER 29000000 .SDGB ANOP 29020000 CDG1 STH 0,CDGSRC+4 NYYY TO MESSG-NO. FIELD 29040000 NI CDGSRC+4,X'0F' 0YYY IN MESSG-NO. FIELD 29060000 SRL 0,12 NO OF TRLRS N0/N3 IN REG 0 29080000 LTR 0,0 29100000 BC 7,CDG2 IF NO. OF TRLRS NOT ZERO, GO TO CDG2 29120000 MVI CDGSRC,X'82' DIAG-WITHOUT-TRLRS CODE TO SRC 29140000 B CDG3 GO TO CDG3 29160000 CDG2 MVI CDGSRC,X'84' DIAG-WITH-TRLRS CODE TO SRC 29180000 CDG3 STH 0,CDGSCN SAVE TRLRS-COUNT 29200000 BAL 1,CDG7 GET POSSEQ IN REG 0 29220000 LR 1,0 POSSEQ TO REG 1 29240000 MVC CDGSRC+1(2),1(1) POS 1/4 AND SEQ 0/11 TO SRC 29260000 TM 0(1),X'01' 29280000 BC 8,CDG4 IF POS 0 IS 0, GO TO CDG4 29300000 OI CDGSRC,X'01' 1 TO POS 0 IN SRC 29320000 CDG4 LA OUTREG,CDGSRC ADR OF DIAG 29340000 BAL L1,CPUT&D CPUT DIAG RECORD 29360000 L L1,CDGSPT RESTORE PNTR 29380000 LH 1,CDGSCN TRLRS-COUNT TO REG 1 29400000 NI CDGSRC,X'E5' 29420000 OI CDGSRC,X'E4' TRLR CODE TO SRC 29440000 LTR 1,1 29460000 BC 8,CDG6 IF NO. OF TRLRS IS ZERO, GO TO CDG6 29480000 CDG5 STH 1,CDGSCN SAVE TRLRS-COUNT 29500000 BAL 1,CDG7 GET ADDR OF NEXT WORD IN REG 0 29520000 LR OUTREG,0 ADR OF NEXT WORD TO OUTREG 29540000 SH OUTREG,CDGTHR DUNK OUTREG BY 3 TO ALLOW SPACE 29560000 * FOR SRC 0/2 IN CIOP IOAREA 29580000 BAL L1,CPUT&D CPUT TRAILER 29600000 L 1,CDGWK ADDR OF REC IN CIOP IOAREA TO REG 1 29620000 MVC 0(3,1),CDGSRC SRC 0/2 TO CIOP IOAREA 29640000 L L1,CDGSPT RESTORE PNTR 29660000 LH 1,CDGSCN TRLRS-COUNT TO REG 1 29680000 BCT 1,CDG5 IF TRLRS-COUNT NOT ZERO, GO TO CDG5 29700000 CDG6 LM 0,1,CDGSAV RESTORE REG 0 AND 1 29720000 L OUTREG,CDGSS2 29740000 BR L1 RETURN TO THE PHASE 29760000 CDG7 ST 1,CDGWK SAVE RETURN ADDR 29780000 L 1,CDGSAV+4 RESTORE REG 1 TO PHASE CONTENTS 29800000 L OUTREG,CDGSS2 RESTORE INITIAL CONTENTS OF OUTREG 29820000 EX 0,0(L1) ADDR OF NEXT WORD TO REG 0 29840000 LA L1,4(L1) UPDATE PNTR 29860000 ST L1,CDGSPT SAVE PNTR 29880000 L 1,CDGWK RESTORE RETURN ADDR 29900000 BR 1 RETURN TO MAIN ROUTINE 29920000 CDGSAV DC 2F'0' SAVE REG 0 AND 1 29940000 CDGSS2 DC F'0' SAVE REG S2 29960000 CDGSPT DC F'0' SAVE POINTER 29980000 CDGSCN DC H'0' SAVE TRLRS-COUNT 30000000 CDGSRC DC H'0' SIX BYTE FIELD 30020000 DC H'2' *SRC AND DIAG-REC 30040000 DC H'0' 30060000 * 30080000 * CONSTANTS 30100000 CDGTHR DC H'3' 30120000 .SCD ANOP 30140000 CDGWK DC F'0' ADDR OF RECORD RETURNED FROM CPUT 30160000 .NDGQ ANOP 30180000 CWKX DC 0F'0' BASE OF DECB POINTER STRING 30200000 CWKA DC 2F'0' INITIALIZED WITH DECB ADDRESSES 30220000 CWKB DC 2F'0' INITIALIZED WITH DECB ADDRESSES 30240000 CWKC DC 2F'0' INITIALIZED WITH DECB ADDRESSES 30260000 CEOF DC F'4' SRC OF EOD RECORD 30280000 &D SETC 'F' 30300000 AIF ('&SIO'(7,1) EQ ' ').REOF 30320000 &D SETC '&SIO'(7,1) 30340000 .REOF ANOP 30360000 CEND DC C'1EO&D.' END OF FILE MARKER 30380000 CWK DC H'0' 30400000 CON4 EQU CEOF+2 SNEAKY WAY TO GET A CONSTANT CHECK 30420000 .SC AIF ('&PHASE' NE 'LST').NCLST 30440000 CCLOSE STM CR13,CR4,CSAVE SPECIAL CCLOSE FOR LST 30460000 L CR2,CCOMM POINT TO COMM AREA 30480000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 30500000 L CR1,UCDCBB(CR2) POINT TO DCB FOR WK B 30520000 LR CR0,CR1 30540000 SH CR0,CON4 POINT TO WORD PRECEDING DCB 30560000 * POINT (1),(0) REPOSITION WK B 30580000 POINT (1),(0) 30600000 LM CR13,CR4,CSAVE 30620000 B 4(L1) 30640000 CON4 DC H'4' 30660000 .NCLST AIF ('&PHASE' NE 'PD1').PD1 30680000 CLOAD STM CR13,CR1,CSAVE STORE REGS IN PRIVATE AREA 30700000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 30720000 CLI CL1+3,C'X' IS THIS THE 1ST LOAD 30740000 BE CL3 IF YES DO NOT DELETE 30760000 BAL CR0,CL2 ELSE POINT TO NAME WITH PARM REG 30780000 CL1 DC C'IEPXXX00' NAME OF CURRENT TABLE 30800000 CL2 SVC 9 DELETE CURRENT TABLE 30820000 CL3 MVC CL1+3(3),0(L1) MOVE IN NEW TABLE NAME 30840000 LA CR0,CL1 POINT TO NEW TABLE NAME 30860000 SR CR1,CR1 INDICATE NO DCB USED--LINKLIB 30880000 SVC 8 LOAD NEW TABLE 30900000 LR S2,CR0 PUT TABLE ADR IN TABLE BASE REG 30920000 LM CR13,CR1,CSAVE RESTORE REGS 30940000 B 4(L1) EXIT 30960000 .PD1 AIF ('&PHASE' NE 'BLD' AND '&PHASE' NE 'AS2' AND '&PHASE' C30980000 NE 'AS3' AND '&PHASE' NE 'AS5' AND '&PHASE' NE C31000000 'PD1').STW1 31020000 CWRITE STM CR13,CR4,CSAVE STORE REGS IN PRIVATE AREA 31040000 ST CR9,CRDSV STORE AREA POINTER 31060000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 31080000 AIF ('&PHASE' EQ 'PD1').WPD11 31100000 CWT0 NI CWTS,X'FE' RESET NOTE SWITCH 31120000 .WPD11 L CR15,CWKB POINT TO WORK B DECB 31140000 L CR15,CTDCB(CR15) LOAD ADR OF WORK B DCB 31160000 ST CR15,CWDECB+CTDCB STORE ADR IN DECB FOR WRITE 31180000 LH CR2,CBLKSI(CR15) CR2 HAS BLKSIZE OF WKB 31200000 STH CR2,CWDECB+CTLT STORE BLKSIZE AS MAX TO WRITE 31220000 MVC CWRD+2(2),0(P1) MOVE LENGTH, WHICH IS 16 BITS AND 31240000 L CR4,CWRD POSITIVE, TO FULL WORD AND LOAD IT. 31260000 * SET N = 0 FOR COMMENTS 31280000 CWT1 ST CR9,CWDECB+CTAR STORE ADR FOR WRITE 31300000 CR CR4,CR2 COMP LNTH - N(BLKSIZE) TO BLKSIZE 31320000 BH CWT2 IF HIGH GO WRITE BLKSIZE CHUNK 31340000 CH CR4,=H'30' AVOID NOISE RECORD 31360000 BH CWT3 31380000 LA CR4,30 31400000 CWT3 STH CR4,CWDECB+CTLT ELSE WRITE LNTH - N(BLKSIZE) 31420000 BAL CR3,CWTC 31440000 LM CR13,CR4,CSAVE RESTORE REGS 31460000 L CR9,CRDSV RESTORE AREA POINTER 31480000 BR L1 31500000 CWT2 BAL CR3,CWTC WRITE BLKSIZE CHUNK 31520000 AR CR9,CR2 BUMP ADR BY BLKSIZE 31540000 SR CR4,CR2 DUNK LNTH BY BLKSIZE,, THUS N=N+1 31560000 B CWT1 LOOP 31580000 CWTC LA CR1,CWDECB POINT TO DECB 31600000 BAL CR14,CWRT GO TO COMMON READ-WRITE LINKAGE 31620000 LA CR1,CWDECB POINT AGAIN TO DECB 31640000 BAL CR14,CCHK GO TO COMMON CHECK LINKAGE 31660000 AIF ('&PHASE' EQ 'PD1').WPD12 31680000 TM CWTS,X'1' IS THIS FIRST WRITE 31700000 BCR 1,CR3 IF NO RETURN 31720000 AIF ('&PHASE' NE 'BLD').NSPT 31740000 TM DSW,SSEG IS NOTE WANTED 31760000 BCR 8,CR3 IF NO RETURN 31780000 .NSPT L CR1,CWDECB+CTDCB ELSE POINT TO DCB 31800000 * NOTE (1) NOTE FIRST OR ONLY WRITE 31820000 NOTE (1) NOTE FIRST OR ONLY WRITE 31840000 ST CR1,CSAVE+16 STORE IN REG SAVE AREA 31860000 OI CWTS,X'1' INDICATE FIRST WRITE HAS BEEN DONE 31880000 .WPD12 BR CR3 31900000 AIF ('&PHASE' NE 'BLD' AND '&PHASE' NE 'PD1').XXQPR 31920000 CRDSV DC F'0' 31940000 .XXQPR ANOP 31960000 AIF ('&PHASE'(1,2) NE 'AS').STW2 31980000 CPWRITE STM CR13,CR4,CSAVE STORE REGS IN PRIVATE AREA 32000000 ST CR9,CRDSV STORE AREA POINTER 32020000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 32040000 L CR2,CCORAD 32060000 CPWT1 C CR1,0(0,CR2) 32080000 LA CR2,4(0,CR2) 32100000 BNE CPWT1 32120000 L CR1,0(0,CR2) 32140000 ST CR1,CRSAVE STORE NOTEWORD IN UNUSED AREA 32160000 LR CR0,CR13 POINT TO NOTEWORD WITH REG 0 32180000 L CR1,CWKB POINT TO WORK B DECB 32200000 L CR1,CTDCB(CR1) LOAD ADR OF WORK B DCB 32220000 * POINT (1),(0) 32240000 POINT (1),(0) 32260000 B CWT0 GO TO NORMAL CWRITE ROUTINE 32280000 .STW2 ANOP 32300000 CWRD DC F'0' WORK FIELD TO LOAD 16 BIT LENGTH 32320000 CWDECB DC F'0' ECB 32340000 DC X'0020' TYPE 32360000 DC H'0' LNTH 32380000 DC F'0' DCB 32400000 DC F'0' AREA 32420000 DC F'0' POINTER 32440000 CWTS DC X'0' SWITCH 32460000 .STW1 AIF ('&PHASE'(2,2) NE 'MG' AND '&PHASE' NE 'LST' AND C32480000 '&PHASE'(1,2) NE 'AS' AND '&PHASE' NE C32500000 'PD2').SRT 32520000 AIF ('&PHASE' EQ 'AS1' OR '&PHASE' EQ 'ASP' OR '&PHASE' EQ C32540000 'ASW' OR '&PHASE' EQ 'ASA').SRT 32560000 CREAD STM CR13,CR4,CSAVE STORE REGS IN PRIVATE AREA 32580000 ST CR9,CRDSV STORE AREA POINTER 32600000 LA CR13,CRSAVE POINT TO SAVE AREA FOR CP USE 32620000 AIF ('&PHASE'(1,2) NE 'AS').SSPQ 32640000 ST CR1,CRSAVE STORE NOTEWORD FROM PHASE 32660000 .SSPQ AIF ('&PHASE' EQ 'LST' OR '&PHASE' EQ 'PD2').NSYMF 32680000 L CR1,CWKB POINT TO WORK B DECB 32700000 L CR1,CTDCB(CR1) LOAD ADR OF WORK B DCB 32720000 AGO .SYMF 32740000 .NSYMF L CR14,CCOMM POINT TO COMMON AREA 32760000 AIF ('&PHASE' EQ 'LST').NSYM1 32780000 L CR1,UCWKB(CR14) POINT TO WORK B DECB 32800000 L CR1,CTDCB(CR1) LOAD WORK B DCB ADR 32820000 AGO .SYMF 32840000 .NSYM1 L CR1,UCDCBB(CR14) POINT TO DCB FOR WORKB 32860000 .SYMF ST CR1,CRDECB+CTDCB STORE ADR IN DECB FOR READ 32880000 LH CR2,CBLKSI(CR1) LOAD BLKSIZE FOR WKB 32900000 AIF ('&PHASE' EQ 'PMG' OR '&PHASE' EQ 'LST' OR '&PHASE' EQ C32920000 'PD2').STPT 32940000 AIF ('&PHASE'(1,2) NE 'AS').SSPP 32960000 LR CR0,CR13 POINT TO PREVIOUSLY STORED NOTEWORD 32980000 ** POINT (1),(0) 33000000 POINT (1),(0) POSITION FILE FOR READ 33020000 AGO .STPT 33040000 .SSPP AIF ('&PHASE' NE 'SMG').SSELPT 33060000 TM SWITCH,SSEG IS POINT REQUIRED 33080000 BZ CRDNPT IF NO SKIP 33100000 .SSELPT MVC CRSAVE(4),0(W1) MOVE NOTEWORD TO FW BOUND 33120000 LR CR0,CR13 POINT TO NOTEWORD 33140000 * POINT (1),(0) 33160000 POINT (1),(0) POSITION FILE FOR READ 33180000 CRDNPT DC 0H'0' 33200000 .STPT BAL CR3,CRDC GO READ FIRST OR ONLY CHUNK 33220000 MVC CWRD+2(2),0(P1) MOVE LENGTH, WHICH IS 16 BITS AND 33240000 L CR4,CWRD POSITIVE, TO FULL WORD AND LOAD IT. 33260000 * SET N=0 FOR COMMENTS 33280000 CREAD1 CR CR4,CR2 COMP. LNTH-N(BLKSIZE) TO BLKSIZE 33300000 BH CREAD2 IF HIGH THERE'S MORE TO BE READ 33320000 LM CR13,CR4,CSAVE ELSE RESTORE REGS 33340000 L CR9,CRDSV RESTORE POINTER TO FIRST OF AREA 33360000 BR L1 AND EXIT 33380000 CREAD2 AR CR9,CR2 BUMP AREA POINTER BY BLKSIZE 33400000 SR CR4,CR2 DUNK LNTH BY BLKSIZE,,THUS N=N+1 33420000 BAL CR3,CRDC GO READ THE N-TH CHUNK 33440000 B CREAD1 LOOP TO SEE IF THERE'S ANY MORE 33460000 CRDC ST CR9,CRDECB+CTAR STORE CURRENT AREA POINTER IN DECB 33480000 LA CR1,CRDECB POINT TO DECB 33500000 BAL CR14,CWRT GO TO COMMON READ-WRITE LINKAGE 33520000 LA CR1,CRDECB POINT TO DECB 33540000 BAL CR14,CCHK GO TO COMMON CHECK LINKAGE 33560000 BR CR3 RETURN 33580000 AIF ('&PHASE' EQ 'AS2' OR '&PHASE' EQ 'AS3' OR '&PHASE' EQ C33600000 'AS5').SCWRD 33620000 CWRD DC F'0' WORK FIELD TO LOAD 16 BIT LENGTH 33640000 .SCWRD ANOP 33660000 CRDECB DC F'0' ECB 33680000 DC X'8080' TYPE 33700000 DC H'0' LNTH 33720000 DC F'0' DCB 33740000 DC F'0' AREA 33760000 DC F'0' POINTER 33780000 CRDSV DC F'0' 33800000 .SRT AIF ('&CIOP'(1,1) EQ 'X' AND '&SIO'(1,4) EQ ' ').SCSP 33820000 CWRT L 15,8(1) WRITE LINKAGE--NON-STANDARD 33840000 L 15,48(15) LOAD READ/WRITE ROUTINE ADR 33860000 BR 15 NON-STANDARD,,REG 14 ALREADY LOADED 33880000 CCHK L 15,8(1) CHECK LINKAGE--NON-STANDARD 33900000 L 15,52(15) LOAD CHECK ROUTINE ADR 33920000 BR 15 NON-STANDARD,,REG 14 ALREADY LOADED 33940000 CSAVE DC 9F'0' FRAME SAVE AREA 33960000 .SCSP AIF ('&PHASE' NE 'AS1' AND '&PHASE' NE 'AS2' AND '&PHASE' C33980000 NE 'AS3' AND '&PHASE' NE 'ASA').SYQ 34000000 CCCON DC 2F'0' 34020000 AIF ('&PHASE' NE 'AS1').SCZP 34040000 ZPUTC BR L1 NO-OP RETURN FOR INCLUDE CARDS 34060000 .SCZP ANOP 34080000 XPUTC STM CR13,CR3,CSAVE STORE REGS IN CIOP AREA 34100000 L CR3,CCOMM POINT TO COMMON AREA 34120000 TM UCNCE(CR3),UXDEK CHECK FOR NO DECK OPTION 34140000 BO CXP2 IF YES SKIP PUNCH COMMAND 34160000 LA CR13,CRSAVE POINT TO SAVE AREA FOR CP USE 34180000 LM CR1,CR2,CCCON LOAD POINTERS TO PUNCH DECB'S 34200000 ST CR1,CCCON+4 SWITCH THEIR LOCATIONS 34220000 ST CR2,CCCON 34240000 LTR CR1,CR1 TEST FOR FIRST WRITE 34260000 BM CXP1 IF FIRST DON'T CHECK 34280000 BAL CR14,CCHK CHECK PREVIOUS WRITE 34300000 CXP1 MVI CCCON+4,X'0' REMOVE FLAG FOR FIRST WRITE 34320000 L CR1,CCCON+4 RELOAD DECB POINTER 34340000 L CR2,CTAR(CR1) LOAD POINTER TO PUNCH BUFFER 34360000 MVC 0(72,CR2),4(S2) MOVE DATA TO PUNCH BUFFER 34380000 MVC 72(4,CR2),XPNAM PROG I.D. FROM LOCAL STORE TO CARD 34400000 UNPK 76(4,CR2),UCPSEQ(3,CR3) PUT OBJECT DECK SEQ. NO. IN BUF 34420000 OI 79(CR2),X'F0' CLEAR SIGN PUNCH FROM SEQ. NO. 34440000 AP UCPSEQ(3,CR3),CONE(1) BUMP OBJECT DECK SEQ. NO. 34460000 BAL CR14,CWRT WRITE BUFFER 34480000 CXP2 LM CR13,CR3,CSAVE RESTORE REGS 34500000 BR L1 RETURN 34520000 CONE DC X'1F00' CONSTANT FOR OBJECT DECK SEQ. NO. 34540000 AGO .SKY 34560000 .SYQ AIF ('&PHASE' NE 'AS4' AND '&PHASE' NE 'AS5' AND '&PHASE' C34580000 NE 'AS6').SY1 34600000 AIF ('&PHASE' NE 'AS6').CA3 34620000 CPCON DC 2F'0' POINTERS TO PRINT DECB'S 34640000 .CA3 ANOP 34660000 CCCON DC 2F'0' POINTERS TO PUNCH DECB'S 34680000 YPUTC STM CR13,CR4,CSAVE STORE REGS IN PRIVATE AREA 34700000 YPUTC2 LA CR3,CCCON POINT TO PUNCH DECB POINTERS 34720000 LA CR4,71 LOAD LENGTH FOR EXECUTING MOVE 34740000 L CR2,CCOMM POINT TO COMM AREA 34760000 TM UCNCE(CR2),UXDEK SET CC ONE IF NODECK OPTION TAKEN 34780000 AIF ('&PHASE' NE 'AS6').CA64 34800000 B COUT GO TO COMMON OUTPUT ROUTINE 34820000 CVC66 STM CR13,CR4,CSAVE STORE REGS IN PRIVATE AREA 34840000 LA CR3,CPCON POINT TO PRINT DECB POINTERS 34860000 LA CR4,119 LOAD LENGTH OF MOVE 34880000 L CR2,CCOMM POINT TO COMM AREA 34900000 TM UCNCE(CR2),UXPMP SET CC ONE IF NOPMAP OPTION TAKEN 34920000 .CA64 ANOP 34940000 COUT BO CXP4 SKIP OUT IF NODECK OR NOPMAP SET 34960000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 34980000 LM CR1,CR2,0(CR3) LOAD POINTERS TO DECB'S 35000000 ST CR1,4(CR3) SWITCH THEIR LOCATIONS 35020000 ST CR2,0(CR3) 35040000 LTR CR1,CR1 TEST FOR FIRST WRITE OF BUFFER 35060000 BM CXP1 IF FIRST DONT CHECK PREVIOUS WRITE 35080000 BAL CR14,CCHK CHECK PREVIOUS WRITE 35100000 CXP1 MVI 4(CR3),X'0' REMOVE FLAG FOR FIRST WRITE 35120000 L CR1,4(CR3) RE-LOAD POINTER TO DECB 35140000 MVC CRSAVE(4),0(L1) MOVE PARAM TO BOUNDARY 35160000 L CR3,CRSAVE LOAD POINTER TO OUTPUT INFO 35180000 L CR2,CTAR(CR1) LOAD POINTER TO BUFFER 35200000 CH CR4,C80 IS THIS A PRINT REQUEST 35220000 BNH CXP5 BRANCH IF PUNCH TO PUT IN SEQ. NO. 35240000 CXP6 MVI 0(CR2),C' ' SINGLE SPACE CHAR, AFTER HEADINGS 35260000 MVI CXP6+1,C' ' SET SINGLE SPACE AFTER FIRST LINE 35280000 LH CR0,CLNS LOAD COUNT OF REMAINING LINES 35300000 BCT CR0,CXP2 BR IF NOT ZERO 35320000 MVI 0(CR2),C'1' ELSE SKIP TO NEXT PAGE 35340000 LH CR0,CLNCT RE-LOAD LINE COUNT 35360000 CXP2 STH CR0,CLNS STORE REMAINING LINE COUNT 35380000 LA CR2,1(CR2) BUMP PAST CONTROL CHARACTER POS. 35400000 CXP3 EX CR4,CMVC MOVE INFO TO BUFFER 35420000 BAL CR14,CWRT WRITE BUFFER 35440000 CXP4 LM CR13,CR4,CSAVE RESTORE REGS USED BY ROUTINE 35460000 BC 15,4(L1) 35480000 CXP5 L CR14,CCOMM POINT TO COMM AREA 35500000 MVC 72(4,CR2),XPNAM PROG I.D. FROM LOCAL STORE TO CARD 35520000 UNPK 76(4,CR2),UCPSEQ(3,CR14) SEQUENCE OBJECT DECK 35540000 OI 79(CR2),X'F0' REMOVE SIGN PUNCH FROM SEQ. NO. 35560000 AP UCPSEQ(3,CR14),CONE(1) BUMP OBJECT DECK SEQUENCE NO. 35580000 B CXP3 RETURN TO COMMON ROUTINE 35600000 CONE DC X'1F00' CONSTANT FOR SEQUENCE NOS. 35620000 CMVC MVC 0(0,CR2),0(CR3) 35640000 C80 DC H'80' 35660000 AGO .SKY 35680000 .SY1 AIF ('&SIO'(3,1) NE 'O').SY2 35700000 CPRINT STM CR13,CR2,CSAVE 35720000 L CR2,CCOMM POINT TO COMM AREA 35740000 AIF ('&PHASE' NE 'LST').NDMAP 35760000 TM UCNCE(CR2),UXDMP CHECK FOR NODMAP OPTION 35780000 AGO .TOGETH 35800000 .NDMAP AIF ('&PHASE' EQ 'PD2').TOG2 35820000 TM UCNCE(CR2),UXLST CHECK FOR NOLIST OPTION 35840000 .TOGETH BO CP3 IF ON SKIP PRINTING 35860000 .TOG2 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 35880000 LM CR1,CR2,CPCON LOAD POINTERS TO DECB'S 35900000 ST CR1,CPCON+4 SWITCH THEIR POSITIONS 35920000 ST CR2,CPCON 35940000 MVC &LIST.(4),CTAR(CR2) LOAD POINTER TO NEXT PRINT AREA 35960000 BAL CR14,CWRT GO TO COMMON I/O LINKAGE TO WRITE 35980000 TM CPCON,X'80' IS THIS FIRST TIME THRU 36000000 BO CP2 IF YES DONT CHECK OTHER DECB 36020000 LR CR1,CR2 ELSE POINT TO OTHER DECB 36040000 BAL CR14,CCHK AND GO CHECK IT 36060000 CP2 MVI CPCON,X'0' 36080000 CP3 LM CR13,CR2,CSAVE RESTORE REGS 36100000 BR L1 36120000 &LIST DC F'0' 36140000 CPCON DC 2F'0' POINTER TO PRINT DECB'S 36160000 .SY2 AIF ('&SIO'(2,1) NE 'I').SKY 36180000 CCCON DC F'0' POINTER TO READER DECB 36200000 CFCON DC 2F'0' FILLED WITH POINTERS TO LIB. DECB'S 36220000 &INPUT DC F'0' POINTER TO NEXT CARD 36240000 CIPT STM CR13,CR4,CSAVE STORE REGS IN CIOP AREA 36260000 LA CR13,CRSAVE POINT TO SAVE AREA FOR O/S USE 36280000 CIPTSW BC 0,CFIPT SWITCH FOR LIBRARY INPUT 36300000 L CR1,CCCON POINT TO READER DECB 36320000 BAL CR14,CCHK GO TO COMMON CHECK ROUTINE TO 36340000 * ENSURE COMPLETION OF PREVIOUS READ. 36360000 * MUST CHECK BEFORE NEXT READ 36380000 L CR1,CCCON POINT TO DECB FOR READ. CHECK 36400000 * WIPES IT OUT. 36420000 L CR2,CTAR(CR1) LOAD ADR OF NEXT BUFFER 36440000 MVC CTAR(4,CR1),&INPUT INSERT ADR OF OTHER BUFFER TO RD. 36460000 ST CR2,&INPUT STORE POINTER TO NEXT BUFFER 36480000 BAL CR14,CWRT GO TO COMMON I/O LINKAGE FOR READ 36500000 LM CR13,CR4,CSAVE RESTORE REGS 36520000 BR L1 EXIT 36540000 CFIND STM CR13,CR4,CSAVE STORE REGS IN CIOP AREA 36560000 LA CR13,CRSAVE POINT TO SAVE AREA FOR C.P. USE 36580000 L CR1,CCOMM POINT TO COMM AREA 36600000 L CR1,UCDCBLIB(CR1) POINT TO LIBRARY DCB 36620000 SR CR14,CR14 CLEAR WORK REG 36640000 AIF ('&PHASE'(1,1) NE 'D').LIBMG 36660000 LA CR0,2(W1) POINT TO NAME 36680000 IC CR14,0(W1) LOAD LENGTH OF MEMBER NAME 36700000 LA CR14,0(W1,CR14) POINT TO POSITION AFTER NAME 36720000 AGO .LIB1 36740000 .LIBMG LA CR0,4(P1) POINT TO MEMBER NAME FROM SOURCE 36760000 IC CR14,3(P1) LOAD LENGTH OF MEMBER NAME 36780000 LA CR14,4(P1,CR14) POINT TO POSITION FOLLOWING NAME 36800000 .LIB1 MVI 0(CR14),C' ' MOVE IN BLANK 36820000 MVC 1(7,CR14),0(CR14) CLEAR AREA TO BLANKS 36840000 FIND (1),(0),D ISSUE FIND ON MEMBER NAME 36860000 B *+4(CR15) BRANCH ON RETURN CODE REGISTER 36880000 B CFGOOD RETURN CODE 0 36900000 B CFBAD NOT ON LIBRARY 36920000 B CFBAD PERM I/O ERROR 36940000 CFGOOD MVI CIPTSW+1,X'F0' SET SWITCH FOR CIPT FROM LIB 36960000 LM CR1,CR2,CFCON LOAD POINTERS TO LIB. DECB'S 36980000 MVC CTAR(4,CR2),&INPUT INPUT BUFFER 1 TO LIB. POOL 37000000 BAL CR14,CWRT ISSUE READ ON BUFFER 1 37020000 LM CR13,CR4,CSAVE RESTORE REGS 37040000 BR L1 37060000 CFIPT LM CR2,CR3,CFCON LOAD POINTERS TO LIBRARY DECB'S 37080000 ST CR3,CFCON SWITCH POINTERS 37100000 ST CR2,CFCON+4 37120000 LR CR1,CR3 POINT TO IDLE BUFFER 37140000 BAL CR14,CWRT ISSUE READ 37160000 LR CR1,CR2 POINT TO BUFFER BEING FILLED 37180000 MVC &INPUT.(4),CTAR(CR2) PASS BUFFER ADR TO PHASE 37200000 BAL CR14,CCHK CHECK ACTIVE BUFFER 37220000 LM CR13,CR4,CSAVE RESTORE REGS 37240000 BR L1 37260000 CFEND MVI CIPTSW+1,X'0' RESET SWITCH TO READER 37280000 LM CR13,CR4,CSAVE RESTORE REGS 37300000 B &EOFLIB GO TO END OF FILE ON LIB. ADR 37320000 CFBAD LM CR13,CR4,CSAVE RESTORE REGS 37340000 B &NFLIB GO TO ADR FOR MEMBER NOT ON LIB 37360000 CFECON DC AL3(CFEND) EOF ADR FOR SYSLIB 37380000 .SKY AIF ('&ENTRY' NE 'CBEGIN').SCBG 37400000 CBEGIN DC 0H'0' 37420000 .SCBG EJECT 37440000 MEND 37460000 ./ ADD SSI=01012747,SOURCE=1,NAME=CIOPC MACRO 00020000 CIOPC &PHASE,&N 00040000 LCLC &CSNAME 00060000 &CSNAME SETC 'IEP&PHASE&N' 00080000 AIF ('&PHASE' NE 'ALC').C0A 00100000 B &CSNAME 00120000 .C0A ANOP 00140000 LTORG 00160000 EJECT 00180000 AIF ('&PHASE' NE 'AS1').C01 00200000 IEPAS1P CSECT 00220000 DS 4000C 00240000 EJECT 00260000 .C01 ANOP 00280000 &CSNAME CSECT 00300000 MEND 00320000 ./ ADD SSI=00013001,SOURCE=1,NAME=CIOPL MACRO 00020000 CIOPL &PHASE 00040000 LTORG 00060000 MEND 00080000 ./ ADD SSI=01030060,SOURCE=1,NAME=CMDEQU MACRO 01000000 CMDEQU 02000000 SPACE 3 03000000 * C R J E C O M M A N D C O D E S 04000000 SPACE 3 05000000 * LABEL CODE COMMAND AND/OR FUNCTION ENTRY POINT 06000000 SPACE 2 07000000 CMDLGN EQU X'81' . LOGON IHKLGN 08000000 CMDLGF EQU X'82' . LOGOFF IHKLGF 09000000 CMDEND EQU X'83' . END IHKEND 10000000 CMDERR EQU X'84' . ERROR ANALYSIS AND RECOVERY IHKERR 11000000 CMDALC EQU X'85' . ALLOCATION (SUBMIT) IHKALC 12000000 CMDGET EQU X'86' . PROVIDE INPUT (SUBMIT) IHKGET 13000000 CMDCDP EQU X'87' . CONDENSE USER LIBRARY IHKCDP 14000000 CMDSUB EQU X'88' . SUBMIT IHKSUB 15000000 CMDCAN EQU X'89' . CANCEL IHKRER03 16000000 CMDRER EQU X'8A' . OPEN SYSOUT DATA SETS IHKRER 17000000 CMDRER01 EQU X'8B' . DELETE A JOB IHKRER01 18000000 CMDRER02 EQU X'8C' . SCRATCH SYSOUT DATA SETS IHKRER02 19000000 CMDOUT EQU X'8D' . OUTPUT IHKOUT 20000000 CMDCONT EQU X'8E' . CONTINUE IHKOUT 21000000 CMDTAB EQU X'8F' . TABSET IHKTAB 22000000 CMDSTS EQU X'90' . STATUS IHKSTS 23000000 CMDDOO EQU X'91' . EXEC IHKEDT 24000000 CMDDEL EQU X'92' . DELETE (MAJOR) IHKEDT 25000000 CMDEDT EQU X'93' . EDIT IHKEDT 26000000 CMDED1DL EQU X'94' . EDIT AND DELETE (MAJOR) IHKED1 27000000 CMDED1DO EQU X'95' . EXEC IHKED1 28000000 CMDEOS EQU X'96' . EDIT OS/360 DATA SET IHKEOS 29000000 CMDSND EQU X'97' . SEND IHKSND 30000000 CMDIPT EQU X'98' . INPUT IHKIPT 31000000 CMDCGN EQU X'99' . CHANGE IHKCGN 32000000 CMDMGE EQU X'9A' . MERGE IHKMGE 33000000 CMDMAA EQU X'9B' . MERGE-ACTIVE AREA LINES IHKMAA 34000000 CMDMUF EQU X'9C' . MERGE-FROM USER LIBRARY IHKMUF 35000000 CMDRNR EQU X'9D' . RENUMBER IHKRNR 36000000 CMDSAV EQU X'9E' . SAVE IHKSAV 37000000 CMDCC1 EQU X'9F' . SHOW JOBS, USERS, ACTIVE IHKCC1 38000000 CMDCC2 EQU X'A0' . SHOW LERB, BRDCST; MODIFY IHKCC2 39000000 CMDCC3 EQU X'A1' . BRDCST IHKCC3 40000000 CMDCC4 EQU X'A2' . MSG DELETE AND SHOW MSGS IHKCC4 41000000 CMDCC5 EQU X'A3' . CENOUT IHKCC5 42000000 CMDSTP EQU X'A4' . SHUT-DOWN IHKSTP 43000000 CMDDEQ EQU X'A5' . JOB TERMINATION IHKDEQ 44000000 CMDLDS EQU X'A6' . LISTDS IHKLDS 45000000 CMDLIB EQU X'A7' . LISTLIB IHKLDS 46000000 CMDLOC EQU X'A8' . OS/360 QUEUE MANAGER IEFLOCDQ 47000000 CMDCC6 EQU X'A9' . SHOW SESS, SESSREL IHKCC6 48000000 CMDPUT EQU X'AA' . OUTPUT IHKPUT 49000000 CMDCC7 EQU X'AB' . USERID IHKCC7 50000000 CMDCC8 EQU X'AC' . MSG IHKCC8 51000000 CMDOPN EQU X'AD' . OPEN OS DATA SET (EDIT) IHKOPN 52000000 SPACE 3 53000000 * R E S I D E N T M O D U L E S 54000000 SPACE 3 55000000 CMDLST EQU X'01' . LIST IHKLST 56000000 CMDSCN EQU X'03' . SCAN IHKSCN 57000000 CMDIRL EQU X'04' . INSERT/REPLACE IHKIRL 58000000 CMDIMP EQU X'05' . IMPLICIT SUB-COMMAND IHKIRL01 59000000 CMDCMODE EQU X'06' . CORRECTION MODE IHKIRL02 60000000 CMDDTE EQU X'07' . DELETE (SUB-COMMAND) IHKIRL 61000000 CMDLBC EQU X'08' . LISTBC IHKCMD 62000000 MEND 63000000 ./ ADD SSI=01012321,SOURCE=1,NAME=CMWTO MACRO 02000020 &NAME CMWTO &MT=,&MSG=,®=,&WAIT=NO,&DISP=,&SIZE= 04000020 LCLA &D 06000020 AIF (T'® NE 'O').A1 08000020 AIF (T'&MT NE 'O' AND T'&MSG NE 'O').A4 10000020 MNOTE 8,'MT AND/OR MSG OPERANDS MISSING' 12000020 MEXIT 14000020 .A4 ANOP 16000020 &D SETA (&MSG-1)*4 18000020 &NAME L R1,&MT . MESSAGE MODULE ADDRESS 20000020 L R1,&D.(R1) . MESSAGE ADDRESS 22000020 AGO .A5 24000020 .A1 ANOP 26000020 AIF ('®' EQ '(1)').A2 28000020 &NAME LR R1,® . MESSAGE ADDRESS 30000020 AGO .A5 32000020 .A2 ANOP 34000020 &NAME DS 0H . NAME FIELD OF ROUTINE 36000020 .A5 ANOP 38000020 AIF ('&DISP' EQ '6').A3 40000020 AIF ('&WAIT' EQ 'YES').A3 42000020 OI CESWT4,X'20' . NO WAIT REQUESTED 44000020 .A3 ANOP 46000020 AIF (T'&SIZE EQ 'O').A6 48000020 AIF ('&SIZE'(1,1) EQ '(').A7 50000020 MVI 0(R1),&SIZE . SIZE OF REPLY 52000020 AGO .A6 54000020 .A7 ANOP 56000020 STC &SIZE,0(R1) . SIZE OF REPLY 58000020 .A6 ANOP 60000020 L R15,PARPRADR . ENTRY TO PARALLEL PRINT 62000020 LA R15,&DISP.(R15) . ENTRY POINT IN DPRINT 64000020 BALR R14,R15 . LINK TO MODULE 66000020 MEND 68000020 ./ ADD SSI=01030061,SOURCE=1,NAME=CNTSRCH MACRO 04000000 CNTSRCH &ITER 08000000 LCLA &A 12000000 .* EACH DOUBLE WORD OF THE DSECT DESCRIBES A COUNT OR SEARCH ARGUMENT. 16000000 .* NORMALLY, SRCHRG HAS THE ADDRESS OF SRCHARG0. THE SINGLE MACRO 20000000 .* ARGUMENT, &ITER, SPECIFIES THE HIGHEST ITERATION DESIRED. THUS 24000000 .* CNTSRCH 3 WILL GENERATE ITERATIONS BEGINNING SRCHARG0, SRCHARG1 28000000 .* SRCHARG2, SRCHARG3. 32000000 CNTSRCH DSECT 36000000 .BEGIN ANOP 40000000 SRCHARG&A DS 0F 44000000 SRCHCC&A DS CL2 48000000 SRCHHH&A DS CL2 52000000 FCOUNT&A DS 0F 56000000 SRCHR&A DS X 60000000 CNTKEY&A DS X 64000000 CNTDATA&A DS 0CL2,C 68000000 SRCHCOD&A DS X 72000000 &A SETA &A+1 76000000 SPACE 80000000 AIF (&A LE &ITER).BEGIN 84000000 MEND 88000000 ./ ADD SSI=01012320,SOURCE=1,NAME=COMCOM MACRO 07000020 &NAME COMCOM 14000020 LCLC &V,&X,&Z 21000020 &V SETC 'DC' 28000020 &X SETC 'XL1' 35000020 &Z SETC '''00''' 42000020 EJECT 49000020 IFDPF1 &V,&X,&Z 56000020 REPBUF EQU INBUFR 63000020 ENTRY REPBUF 70000020 EJECT 77000020 MEND 84000020 ./ ADD SSI=01012034,SOURCE=1,NAME=COMMON MACRO 00050021 COMMON &MF=E 00100021 AIF ('&MF' EQ 'E').GEND 00150021 AIF ('&MF' EQ 'L').GENC 00200021 MNOTE 12,'INVALID MACRO FORMAT' 00250021 MEXIT 00300021 .GEND ANOP 00350021 COMMON DSECT 00400021 AGO .GEN 00450021 .GENC ANOP 00500021 IMDPRCOM CSECT 00550021 COMMON EQU IMDPRCOM 00600021 .GEN ANOP 00650021 SPACE 00700021 *********************************************************************** 00750021 * * 00800021 * THE FOLLOWING ARE CONSTANTS AND POINTERS COMMON TO ALL ROUTINES * 00850021 * * 00900021 *********************************************************************** 00950021 SPACE 01000021 ERRADDR DC F'0' ERROR ROUTINE ADDRESS 01050021 VERBGN DC F'0' 01100021 VERBEND DC F'0' 01150021 KYWDBGN DC F'0' 01200021 KYWDEND DC F'0' 01250021 DELIMCD DC F'0' 01300021 ERRMSK DC F'3' 01350021 TRNSVCTB DC F'0' 01400021 WORK1 DC D'0' 01450021 WORK3 DC D'0' 01500021 ADDRMAX DC F'6291455' 01550021 ADDRMAX1 DC F'6291455' 01600021 NUCTOP DC F'250000' 01650021 SIX DC F'6' 01700021 ENTRYLN DC F'32' 01750021 LINELN EQU ENTRYLN 01800021 LINECNT DC F'1' 01850021 PAGENUMB DC F'0' 01900021 CURBUF DC F'0' 01950021 TCBLIST DC F'0' 02000021 TIOTADDR DC F'0' 02050021 CVTADDR DC F'0' 02100021 CURTCB DC F'0' 02150021 SECCVTA DC F'0' 02200021 CVTHEAD DC F'0' 02250021 MSTRTCB DC F'0' 02300021 MSTRDTR DC F'0' 02350021 PCBPTR DC F'0' 02400021 LOWADDR DC F'0' 02450021 WTORECB DC F'0' 02500021 PRFXA DC F'0' 02550021 FREESIZE DC F'8192' 02600021 INDD DC CL8'TAPE' 02650021 FILESEQ DC H'1' 02700021 DUMPSEQ DC H'1' 02750021 JBNAMEA DC A(JBNAME1) 02800021 DC A(JBNAME2) 02850021 DC A(JBNAME3) 02900021 DC A(JBNAME4) 02950021 DC A(JBNAME5) 03000021 DC A(JBNAME6) 03050021 DC A(JBNAME7) 03100021 DC A(JBNAME8) 03150021 DC A(JBNAME9) 03200021 DC AL1(128) 03250021 DC AL3(JBNAME10) 03300021 GPRCD DC A(0-2048) 03350021 DIGMASK DC F'15' 03400021 RDENTRY DC F'0' 03450021 READNO DC F'0' 03500021 RDERCNT DC F'0' 03550021 READTM DC F'0' 03600021 JBNAME1 DC CL8' ' 03650021 JBNAME2 DC CL8' ' 03700021 JBNAME3 DC CL8' ' 03750021 JBNAME4 DC CL8' ' 03800021 JBNAME5 DC CL8' ' 03850021 JBNAME6 DC CL8' ' 03900021 JBNAME7 DC CL8' ' 03950021 JBNAME8 DC CL8' ' 04000021 JBNAME9 DC CL8' ' 04050021 JBNAME10 DC CL8' ' 04100021 IOPSW DC 2F'0' 04150021 CAW DC F'0' 04200021 TWOHK DC X'00030000' 04250021 TREGSAVE DC 2F'0' 04300021 ONEA DC H'1' 04350021 TWO DC H'2' 04400021 THREE DC H'3' 04450021 FOUR DC H'4' 04500021 FIVE DC H'5' 04550021 SEVEN DC H'7' 04600021 EIGHT DC H'8' 04650021 HTEN DC H'10' 04700021 ELEVEN DC H'11' 04750021 TWELVE DC H'12' 04800021 SIXTEEN DC H'16' 04850021 TWENTY DC H'20' 04900021 FIFTY DC H'50' 04950021 TWOHND DC H'200' 05000021 LNCNT EQU 58 05050021 LINENUMB DC AL2(LNCNT) 05100021 LINENUM DC AL2(LNCNT-2) 05150021 SWA DC X'00' 05200021 SWB DC X'00' 05250021 SWC DC X'00' 05300021 SWD DC X'00' 05350021 SWE DC X'00' 05400021 BUFSW DC X'00' 05450021 PRSW DC X'00' 05500021 STGSW DC X'00' 05550021 LOADSW DC X'00' 05600021 PRFMTSW DS C 05650021 TCB DC C'TCB' 05700021 WTORMSG DC CL81' ' 05750021 BLANKS DC CL8' ' 05800021 TITLE DC C'TITLE' 05850021 SYSINIT DC CL8'SYSINIT' 05900021 STOP DC C'STOP' 05950021 MASTER DC CL8'MASTER' 06000021 FILE1 DC C'FILE1' 06050021 MSG1 DC C'IMD161I FORMAT ERROR ' 06100021 MSG2 DC C'IMD158I I/O ERROR ON DUMP ' 06150021 MSG3 DC C'IMD159I IMDPRDMP PGM CHECK' 06200021 TITLEMSG DC CL64' ' 06250021 TITLEMOD DC CL15'MODULE' . MODULE ISSUING DUMP 06300021 DC CL2' ' 06350021 TITLEDTE DC CL13'DATE' 06400021 DC CL2' ' 06450021 TITLETME DC CL13'TIME' 06500021 DC CL2' ' 06550021 TITLEPGE DC CL9'PAGE' 06600021 ROLLMSG DC CL10'ROLLED OUT' 06650021 CAPTABL DC X'000102030405060708090A0B0C0D0E0F' 06700021 DC X'101112131415161718191A1B1C1D1E1F' 06750021 DC X'202122232425262728292A2B2C2D2E2F' 06800021 DC X'303132333435363738393A3B3C3D3E3F' 06850021 DC X'404142434445464748494A4B4C4D4E4F' 06900021 DC X'505152535455565758595A5B5C5D5E5F' 06950021 DC X'606162636465666768696A6B6C6D6E6F' 07000021 DC X'707172737475767778797A7B7C7D7E7F' 07050021 DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' 07100021 DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F' 07150021 DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' 07200021 DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 07250021 DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' 07300021 DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' 07350021 DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' 07400021 DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' 07450021 TABLE DC 64C'.' 07500021 DC C' ' 07550021 DC 128C'.' 07600021 DC C'ABCDEFGHI' 07650021 DC 7C'.' 07700021 DC C'JKLMNOPQR' 07750021 DC 8C'.' 07800021 DC C'STUVWXYZ' 07850021 DC 6C'.' 07900021 DC C'0123456789' 07950021 DC 6C'.' 08000021 ORG *-193 08050021 HEXTABL EQU * 08100021 ORG *+193 08150021 DC X'FAFBFCFDFEFF' 08200021 ORG *+41 08250021 DC C'0123456789' 08300021 ORG *-240 08350021 EBCTABL EQU * 08400021 ORG *+240 08450021 DC C'0123456789ABCDEF' 08500021 BLNK DC 64X'00' 08550021 DC X'0C' BLANK 08600021 DC 12X'00' 08650021 DC X'10' LEFT PAREN 08700021 DC 15X'00' 08750021 DC X'14' RIGHT PAREN 08800021 DC 13X'00' 08850021 DC X'04' COMMA 08900021 DC 18X'00' 08950021 DC X'08' EQUAL SIGN 09000021 DC 129X'00' 09050021 EJECT 09100021 *********************************************************************** 09150021 * * 09200021 * COMMON A TYPE ADDRESS CONSTANTS * 09250021 * * 09300021 *********************************************************************** 09350021 SPACE 09400021 AIF ('&MF' EQ 'E').GENDS 09450021 AWRITE DC A(IMDPRWTR) ADRESS OF ROUTINE FOR OUTPUT 09500021 APRTMSG DC A(IMDPRMSG) ADDR OF MESSAGE ON SYSPRINT RTN 09550021 ASYNTAX DC A(IMDPRSYN) ADDR OF SYNTAX ERROR ROUTINE 09600021 AFMTLINE DC A(IMDPRGFR) ADDR OF LINE FORMAT ROUTINE 09650021 AADRCNVT DC A(ADRCNVT) ADDR OF 3 BYTE CONVERT ROUTINE 09700021 AWRDCNVT DC A(WRDCNVT) ADDR OF 4 BYTE CONVERT ROUTINE 09750021 AGO .NOGENDS 09800021 .GENDS ANOP 09850021 AWRITE DS A ADRESS OF ROUTINE FOR OUTPUT 09900021 APRTMSG DS A ADDR OF MESSAGE ON SYSPRINT RTN 09950021 ASYNTAX DS A ADDR OF SYNTAX ERROR ROUTINE 10000021 AFMTLINE DS A ADDR OF LINE FORMAT ROUTINE 10050021 AADRCNVT DS A ADDR OF 3 BYTE CONVERT ROUTINE 10100021 AWRDCNVT DS A ADDR OF 4 BYTE CONVERT ROUTINE 10150021 .NOGENDS ANOP 10200021 READADDR DC V(IMDPRRDC) ADDR OF READ ROUTINE 10250021 ARGNBND DS A ADDRESS OF REGION BOUNDRY ROUTINE 10300021 DS A . RESERVED 10350021 STOPEXIT DS A . ADDR STOP EXIT ROUTINE 10400021 DS A . RESERVED 10450021 SYNMSGA DS A ADDR OF SYNTAX ERROR MSG ARRAY 10500021 AEREXIT DC V(IMDPRXIT) . ADDR OF ERROR EXIT ROUTINE 10550021 ALOADER DC V(IMDPRSEG) ADDR SEGMENT LOAD ROUTINE 10600021 AALLRGN DS A . ADDR OF IMDPRFUR - ALL REGIONS RTN 10650021 ATIOTTST DS A . ADDR OF TIOT ELE TEST ROUTINE 10700021 ATIOTPRG DS A . ADDR OF TIOT ELE PURGE ROUTINE 10750021 TSOCTRLB DS A . ADDR OF TSO CONTROL BLOCK 10800021 AIF ('&MF' EQ 'E').GENDS1 10850021 ATCBSAVE DC A(IMDPRTSV) . ADDR OF TCB SAVE ROUTINE 10900021 ATCBREMV DC A(TCBREMV) . ADDRESS OF ROUTINE FOR REMOVING TCBS 10950021 ATCBRTRV DC A(TCBRTRV) . ADDR OF TCB RETRIEVE ROUTINE 11000021 AGO .NGENDS1 11050021 .GENDS1 ANOP 11100021 ATCBSAVE DS A . ADDR OF TCB SAVE ROUTINE 11150021 ATCBREMV DS A . ADDRESS OF ROUTINE FOR REMOVING TCBS 11200021 ATCBRTRV DS A . ADDR OF TCB RETRIEVE ROUTINE 11250021 .NGENDS1 ANOP 11300021 APCBENQ DS A PCB Q MGMT. 11350021 DS A . RESERVED 11400021 AIF ('&MF' EQ 'E').GENDS2 11450021 ASTPROUT DC A(IMDPRSTP) . ADDR OF THE STOP ROUTINE 11500021 AGO .NGENDS2 11550021 .GENDS2 ANOP 11600021 ASTPROUT DS A . ADDR OF THE STOP ROUTINE 11650021 .NGENDS2 ANOP 11700021 AFORMAT DS A ADDR OF ROUTINE THAT CONTROLS THE 11750021 * FORMATTING OF THE CONTROL BLOCKS 11800021 APRTSTG DS A ADDR OF PRINT STORAGE SERVICE 11850021 * ROUTINE 11900021 BUFSUM DC F'0' . TOTAL NUMBER OF BUFFERS FOR THIS 11950021 * EXECUTION 12000021 BUFREINT DC F'0' . NUMBER OF TIMES BUFFERS WERE 12050021 * INITIALIZED 12100021 WORKTTR DC A(0) . HIGHEST TTR IN SYSUT1 WORK FILE 12150021 NSWPREAD DC F'0' . NUMBER OF READS FROM SWAP DATA SET 12200021 AERRMSGA DC A(MSG3) ERROR MESSAGE ARRAY - MESSAGE 12250021 DC A(MSG1) TEXT IS DEFINE IN COMMON CONSTANTS 12300021 DC A(MSG2) ABOVE 12350021 AEND DC V(IMDPREND) 12400021 ONGOPTR DS A . POINTER TO ONGO OPERAND 12450021 ATCBSMFR DS A SUMMARY TABLE FREE ROUTINE 12500021 ATCBSMGT DS A SUMMARY TABLE GET ROUTINE 12550021 ATCBSMRY DS A SUMMARY TABLE PRINT ROUTINE 12600021 OLDPICA DC A(0) . SAVEAREA FOR PICA ADDRESS 12650021 DCBADDRS DS 0F 12700021 AOUTDCB DC A(0) . ADDR OF OUTPUT DCB (PRINTER) M0732 12750021 APTRDCB DC A(0) . ADDR OF MESSAGE DCB M0732 12800021 * (SYSPRINT) M0732 12850021 ARDRDCB DC A(0) . ADDR OF CNTRL CARD INPUT DCB M0732 12900021 * (SYSIN) M0732 12950021 AINDCB DC A(0) . ADDR OF DUMP TAPE INPUT DCB M0732 13000021 * (TAPE) M0732 13050021 DC AL1(X'80') . END OF LIST INDICATOR M1634 13060021 ASYSUDCB DC AL3(0) . ADDR OF UTILITY DA DCB M1634 13100021 * (SYSUT1 OR 2) M1634 13150021 EJECT 13300021 *****************************************************************S21014 13350021 * S21014 13400021 * IMDPRCOM CHANGES FOR GTF S21014 13450021 * S21014 13500021 *****************************************************************S21014 13550021 SPACE 13600021 TRCCOUNT DC F'0' . COUNT OF ENTRIES TO IMDPRGET S21014 13650021 AEDITCB DC A(0) . ADDRESS OF EDIT COMMUNICATION S21014 13700021 * AREA - IMDPRTAB S21014 13750021 AROOT DC A(0) . ADDRESS OF IMDPRTAB INIT RTN. S21014 13800021 EDITER DC X'02' . VALUE OF ER PARAMETER OF S21014 13850021 * EXECUTE CARD S21014 13900021 EJECT 13950021 MEND 14000021 ./ ADD SSI=01030080,SOURCE=1,NAME=CREAD MACRO 02000000 &NAME CREAD &INIT 04000000 LCLA &A,&OPNUM 06000000 LCLB &CHRNUM,&SETIN,&SETRST 08000000 LCLC &PARAM 10000000 &A SETA 2 12000000 &OPNUM SETA N'&SYSLIST NNUMBER OF OPERANDS 14000000 AIF (&OPNUM EQ 0).CONT NO OPERAND 16000000 AIF (&OPNUM GT 1).CHECK MORE THAN ONE OPER SPEC 18000000 &CHRNUM SETB (K'&INIT GT 1) 20000000 AIF (&CHRNUM).ERR2 OPERAND WITH MORE THAN 1 CHAR 22000000 &PARAM SETC '&INIT' 24000000 &SETRST SETB ('&PARAM' EQ 'R') 26000000 AIF (NOT &SETRST).RESET 28000000 &A SETA 13 30000000 AGO .CONT 32000000 .RESET ANOP 34000000 &SETIN SETB ('&PARAM' EQ 'I') 36000000 AIF (NOT &SETIN).ERR3 38000000 &A SETA 3 40000000 .CONT ANOP 42000000 CNOP 0,4 44000000 &NAME OI 4(15),X'&A' SET REQUEST FLAGS 46000000 BAL 1,*+8 LOAD ADD OF NEXT IN REG 1 48000000 .PRMLST DC F'0' FULL WORD 50000000 ST 15,0(0,1) STORE ADDRESS IN PARM LIST 52000000 L 15,IHKYYLAD GET ENTRY POINT ADDRESS 54000000 BALR 14,15 LINK TO LINE ADMINISTRATOR 56000000 MEXIT 58000000 .CHECK AIF (N'&SYSLIST(1) EQ 0).ERR0 FIRST OPERAND OMITT. 60000000 MNOTE 7,'MORE THAN ONE OPERAND SPECIFIED' 62000000 MEXIT 64000000 .ERR2 MNOTE 7,'OPERAND CONSISTS OF MORE THAN ONE CHARACTER' 66000000 MEXIT 68000000 .ERR3 MNOTE 7,'OPERAND INCORRECTLY SPECIFIED' 70000000 MEXIT 72000000 .ERR0 MNOTE 7,'MORE OPERANDS SPECIFIED AND FIRST OPER OMITTED' 74000000 MEND 76000000 ./ ADD SSI=01030071,SOURCE=1,NAME=CREATE MACRO 03000000 &NAME CREATE &A,&FTYPE=,&ACTNUM= 06000000 GBLA &RAFIOPR,&RAFIORG 09000000 LCLC &ANUM 12000000 LCLC &NAM 15000000 &NAM SETC '&NAME' 18000000 AIF ('&FTYPE' NE '').GO2 21000000 &ANUM SETC '1' PRIVATE DEFAULT =1 24000000 AIF ('&ACTNUM' EQ '').GO1 27000000 &ANUM SETC '&ACTNUM' OTHER PRIVATE, SET ACTNUM 30000000 .GO1 ANOP 33000000 &NAM SETC '' 36000000 &NAME MVI ACTNUMFS,&ANUM 39000000 AGO .GO3 42000000 .GO2 AIF ('&ACTNUM' EQ '').GO3 45000000 &NAM SETC '' 48000000 &ANUM SETC '&ACTNUM' 51000000 &NAME MVI GBLNUMFS,&ANUM . SET GLOBAL FILE NUMBER 54000000 .GO3 ANOP 57000000 VALARG (&A),(2,IS,O),(&FTYPE),(3,,GBL,XGBL) 60000000 RAFIOARG (&A,&FTYPE,CREATE) 63000000 &NAM LA &RAFIORG,&RAFIOPR 66000000 RCALL AFIO 69000000 MEND 72000000 ./ ADD SSI=30130002,NAME=CTLPROGD,SOURCE=0 MACRO 00200013 CTLPROGD 00400013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--ENTRY INTERFACE ROUTINE' 00600013 * ENTRY INTERFACE SUBROUTINE 00800013 * 01000013 * 01200013 * THIS SUBR IS ENTERED FROM THE SUPERVISOR'S SVC 01400013 * FLIH WHENEVER A QTAM SUPERVISOR CALL IS ISSUED. THE 01600013 * SUBR PERFORMS INITIALIZATION FOR THE QTAM CONTROL 01800013 * ROUTINE. 02000013 * 02200013 * 02400013 * ASSOCIATED WITH EACH ENTRY TO THE SUBR IS A 02600013 * SVRB CREATED BY THE SUPERVISOR. THIS SVRB IS CONVERTED TO A QTAM 02800013 * SUBTASK CONTROL BLOCK. ONE OTHERWISE UNUSED WORD IN THE SVRB IS 03000013 * ZEROED AND LATER USED AS AN ECB FOR CONTROLING THE DISPATCHING 03200013 * OF THE SUBTASK IT IS ASSOCIATED WITH. 03400013 * 03600013 * 03800013 * THIS 'NEW' STCB IS PLACED AT THE HEAD OF THE STCB 04000013 * CHAIN OF THE QCB FOR THE LAST DISPATCHED QUEUE (THE QUEUE 04200013 * FROM WHICH A SUBTASK WAS LAST ACTIVATED BY QTAM) IF THAT 04400013 * QCB IS STILL ON THE READY QUEUE. IF THE LAST DISPATCHED 04600013 * QUEUE IS NO LONGER ON THE READY QUEUE, THE NEW STCB IS 04800013 * ITSELF PLACED AT THE TOP OF THE READY QUEUE. THE ENTRY 05000013 * INTERFACE SUBR THEN EXITS TO THE WAIT OR THE POST 05200013 * SUBROUTINE, DEPENDING ON WHICH SVC HAS BEEN ISSUED. 05400013 * 724000 A36508 05500020 *C678000-682000,A697000,A964100-964600 A49840 05550021 SPACE 05600013 IGC065 DS 0X 05800013 IGC067 DS 0X 06000013 BALR BREG,0 06200013 USING *,BREG 06400013 MVI IOSSAVE,255 SET SVC ENTRY FLAG 06600013 * 06800013 * LOAD ADDRESSES OF THE TCB, ENTRY SVRB AND MODULE IGG019NG 07000013 * 07200013 L 13,16 LOAD ADDRESS OF THE CVT 07400013 L TCBREG,0(0,13) LOAD ADDRESS OF TCB POINTERS 07600013 L TCBREG,4(TCBREG) LOAD OLD TCB ADDRESS 07800013 L 13,156(0,13) ADDRESS OF THE TERMINAL TABLE 08000013 L 13,4(0,13) ADDRESS OF IGG019NG 08200013 L Y,TCBRBP ADDR OF RB AT TOP OF PUSH-DOWN LIST 08400013 XC XRBQ(4),XRBQ ZERO ECB FOR WAIT 08600013 L QREG,QSAVE LOAD LAST QUEUE ADDRESS 08800013 * 09000013 * PLACE NEW STCB (ENTRY RB) IN STCB CHAIN OF LAST DISPATCHED 09200013 * QUEUE. 09400013 * 09600013 MVC QSAVE+1(3),DUMMY WAITRB ADDRESS TO QSAVE 09800013 MVC TPRI(4),QTRAN NEXT STCB ADDRESS TO NEW STCB 10000013 MVC TFILL(4),DUMMY-1 QUEUE ADDRESS TO THE STCB 10200013 MVC QTRAN+1(3),TCBRBP+1 NEW STCB ADDRESS TO LAST QUEUE 10400013 * 10600013 * SET THE PRIORITY OF THE NEW STCB 10800013 * 11000013 MVI TPRI,X'DC' SET LOW PRIORITY IN STCB A25336 11200019 L TCBREG,0(13) LPS QUEUE ADDRESS 11400013 NC TPRI,288(TCBREG) SET TO ZERO FOR CLOSEDOWN 11600019 MVC RQSAVE(5),READY 00PS 11800019 B ZEROPRI 00PS 12000019 RQSAVE DC 6X'00' ADDRESS AT TOP OF READY QUEUE 00PS 12200019 * 12600013 * EXIT TO POST OR WAIT ROUTINES 12800013 * 13000013 ZEROPRI L TCBREG,XRBREG+8 LOAD PASSED REGISTER 2 13200013 LA TREG,0(TCBREG) COPY REGISTER AND CLEAR HI ORDER 13400013 L X,XRBLNK-1 GET POINTER TO PRECEDING RB 13600013 CLI XRBPSW+3-TBLOCK(X),QWAIT EXAMINE SVC CODE 13800013 BE WAIT FALL THRU IF POST 14000013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--POST SUBROUTINE' 14200013 * QTAM POST SUBROUTINE 14400013 * THE POST SUBR PLACES THE ADDR OF THE QCB NAMED BY THE CALLING 14600013 * ROUTINE INTO THE QCB ADDR FIELD OF THE SPECIFIED ELEMENT. THE POST 14800013 * ROUTINE BRANCHES TO THE PRIORITY SEARCH SUBR TO CAUSE THE ELEMENT TO 15000013 * BE PLACED ON THE READY QUEUE IN PRIORITY ORDER. 15200013 SPACE 15400013 * 15600013 * ASSIGN ELEMENT PRIORITY IF REQUESTED 15800013 * 16000013 MVI QKEY,2 SET QUEUE NOT WAITING 16200013 CR TREG,TCBREG WAS PRIORITY PASSED 16400013 BE POST BRANCH IF NO PRIORITY PASSED 16600013 MVC FPRI,XRBREG+8 SET ELEMENT PRIORITY 16800013 * 17000013 * INITIALIZE FOR PRIORITY INSERT ROUTINE 17200013 * 17400013 POST ST TREG,FKEY PUT QCB'S ADDR IN ELEMENT 17600013 LA QREG,READY POINT QREG TO HEAD OF READY QUEUE 17800013 B PRIORITY BRANCH TO PRIORITY WITH-- 18000013 * QREG EQ. READY QUEUE HEAD 18200013 * FREG EQ. ELEMENT ADDRESS 18400013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--WAIT SUBROUTINE' 18600013 * QTAM WAIT SUBROUTINE 18800013 * WHEN THE WAIT SUBR IS ENTERED, THE STCB REPRESENTING RE-ENTRY 19000013 * TO THE CALLING ROUTINE (WHEN THE WAIT CONDITION IS SATISFIED) HAS 19200013 * ALREADY BEEN CHAINED INTO A QCB BY THE ENTRY INTERFACE SUBR. 19400013 * THE WAIT SUBR DETERMINES WHAT FURTHER DISPOSITION SHOULD BE MADE, 19600013 * BASED ON CURR CONDITIONS, TO SCHED THE SUBTASK FOR ACTIVATION. FOUR 19800013 * SETS OF CONDITIONS DETERMINE THE DISPOSITION. 20000013 * 1. IF THE SPECIFIED QCB HAS A KEY OF 2, THE WAIT SUBR MAKES NO 20200013 * FURTHER DISPOSITION BUT BRANCHES IMMEDIATELY TO THE DEFER-ENTRY SUBR. 20400013 * 2. IF THE SPECIFIED QCB HAS AN ELEMENT AVAILABLE ON ITS ECB THE 20600013 * STCB IS LEFT LINKED INTO WHATEVER QCB THE ENTRY INTERFACE SUBR HAD 20800013 * CHAINED IT INTO. THE WAIT SUBR THEN BRANCHES TO THE EXIT SELECT 21000013 * SUBR. THIS CAUSES THE ADDR OF THE ELEMENT FOUND ON THE USER- 21200013 * SPECIFIED QCB'S ELEMENT CHAIN TO BE PLACED IN THE CALLING ROUTINE'S 21400013 * PARAMETER REGISTER, WHICH IS ITSELF STORED IN THE SAVE AREA OF THE 21600013 * STCB. THE NET EFFECT IS THAT AT THE TIME THE SUBTASK IS ACTIVATED, 21800013 * IT APPEARS IN THE STCB CHAIN OF THE QATTACH QCB, OR THE STCB CHAIN 22000013 * OF THE DISPATCHED QUEUE. THE ELEMENT CHAIN FROM WHICH IT IS DRAWING 22200013 * ELEMENTS, HOWEVER, IS THAT OF THE QCB SPECIFIED BY THE CALLING 22400013 * ROUTINE. 22600013 * 3. IF THE SPECIFIED QCB HAS NO ELEMENTS AVAILABLE, BUT THE LAST- 22800013 * DISPATCHED QUEUE AND THE QUEUE SPECIFIED BY THE CALLING ROUTINE ARE 23000013 * THE SAME, THE STCB IS ALREADY CHAINED INTO THE CORRECT QCB AND THAT 23200013 * QCB IS ALREADY WAITING ON THE READY QUEUE. THE WAIT SUBR BRANCHES TO 23400013 * THE DISPATCH SUBR. 23600013 * 4. IF THE SPECIFIED QCB HAS NO ELEMENTS AVAILABLE AND IS NOT THE 23800013 * QCB FOR THE LAST-DISPATCHED QUEUE, THE STCB MUST BE LINKED INTO THE 24000013 * SPECIFIED QCB'S STCB CHAIN. THEREFORE, THE WAIT SUBR FALLS THRU TO 24200013 * THE DEFER-ENTRY SUBR. 24400013 SPACE 24600013 DROP Y 24800013 USING TBLOCK,TREG 25000013 WAIT MVI QATTACH,0 25200013 TM QKEY-QBLOCK(TREG),1 IS QWAIT QUEUE NOT WAITING 25400013 BZ UNAVAIL BR. YES UNABLE TO ASSIGN ELEMENT 25600013 * 25800013 * IF AN ELEMENT IS AVAILABLE ASSIGN IT TO STCB WHICH ISSUED QWAIT 26000013 * 26200013 L FREG,QKEY-QBLOCK(0,TREG) ADDRESS OF FIRST ELEMENT IN 26400013 * THE ELEMENT CHAIN OF THE QUEUE 26600013 * BEING WAITED ON. 26800013 MVC QFAC-QBLOCK(,TREG),FLINK REMOVE FIRST ELEMENT FROM CHAIN 27000013 CL FREG,QKEY-QBLOCK(0,TREG) IS ELEMENT DUMMY END ELEMENT 27200013 BNE RETURNX NO- BRANCH TO DISPATCH SUBTASK 27400013 * WHICH ISSUED QWAIT 27600013 * 27800013 * EXIT TO QDISPATCH IF ENTRY INTERFACE ROUTINE PUT STCB IN THE 28000013 * CORRECT QUEUE. 28200013 * 28400013 CLR TREG,QREG IS QWAIT QUEUE EQUAL TO LAST 28600013 * DISPATCHED QUEUE. 28800013 BE DISPATCH BRANCH IF YES THE STCB IS IN THE 29000013 * CORRECT QUEUE. 29200013 * FALL THRU TO DEFER-ENTRY RTN WHEN DIFFERENT. 29400013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--DEFER ENTRY ROUTINE' 29600013 * DEFER-ENTRY SUBROUTINE 29800013 * THIS SUBR CAUSES ENTRY TO A SUBTASK TO BE DEFERRED. WHEN A 30000013 * CONTROL SUBR ENCOUNTERS AN STCB FOR A SUBTASK THAT CANNOT BE 30200013 * ACTIVATED, A BRANCH TO THE DEFER-ENTRY SUBR IS TAKEN. THIS SUBR 30400013 * CAUSES THE STCB TO BE REMOVED FROM THE POSITION AT WHICH IT WAS 30600013 * ENCOUNTERED AND LINKED INTO THE APPROPRIATE STCB CHAIN. 30800013 * AFTER RETRIEVING THE POINTER TO THE STCB FROM THE LOCATION WHERE 31000013 * IT WAS ENCOUNTERED AND RESTORING THAT LOCATION TO ITS FORMER STATE, 31200013 * THE DEFER-ENTRY SUBR BRANCHES TO PRIORITY. THIS CAUSES THE STCB TO 31400013 * BE PLACED, BY PRIORITY ORDER, INTO THE STCB CHAIN OF THE QCB 31600013 * SPECIFIED BY THE CALLING ROUTINE. 31800013 * AN EXCEPTION ARISES IF THE KEY OF THE QCB SPECIFIED BY THE 32000013 * CALLING ROUTINE IS 2. THIS CONDITION INDICATES THAT THE HIGHEST- 32200013 * PRIORITY SUBTASK ON THE QCB'S STCB CHAIN IS NOT WAITING FOR ELEMENTS 32400013 * AND IS READY TO RECEIVE CONTROL. THE STCB BEING PROCESSED, HOWEVER, 32600013 * IS NOT READY. IF IT IS OF HIGHER PRIORITY THAN THE READY SUBTASK IT 32800013 * CANNOT BE PLACED AT THE HEAD OF THE STCB CHAIN WITHOUT PRE-EMPTING 33000013 * THE 'READY' STATUS THAT APPLIES TO THE CURR TOP STCB AND THAT SHOULD 33200013 * BE HONORED FIRST FOR MAX EFFICIENCY. THEREFORE, THE DEFER-ENTRY SUBR 33400013 * ENTERS PRIORITY BY A PATH THAT ENSURES THAT THE NEW STCB IS ENQUEUED 33600013 * BY PRIORITY ORDER BELOW THE CURRENT TOP STCB. 33800013 SPACE 34000013 UNAVAIL L FREG,QTRAN POINT TO HEAD OF STCB CHAIN 34200013 MVC QTRAN+1(3),TLINK-TBLOCK(FREG) REMOVE STCB FROM CHAIN 34400013 LA QREG,QTRAN-QBLOCK(0,TREG) POINT TO NEXT STCB IN CHAIN 34600013 CLI QKEY-QBLOCK(TREG),2 IS PASSED QCB ON READY QUEUE 34800013 * NOT WAITING. 35000013 BNE PRIORITY BRANCH NO TO ENQUEUE NEW STCB 35200013 * IN STCB CHAIN BY PRIORITY. 35400013 * 35600013 * ENSURE NEW STCB WILL BE ENQUEUED BELOW STCB AT HEAD OF QUEUE 35800013 * 36000013 L TREG,QKEY POINT TREG TO FIRST STCB IN CHAIN 36200013 SCAN LA QREG,TPRI POINT QREG TO LINK FIELD OF ITEM 36400013 * 36600013 * 36800013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--PRIORITY SEARCH SUBR' 37000013 * PRIORITY SEARCH SUBROUTINE 37200013 * THIS IS A GENERALIZED SUBR THAT DETERMINES THE POSITION WITHIN A 37400013 * CHAIN THAT AN ITEM SHOULD ASSUME IN ORDER TO BE IN CORRECT PRIORITY 37600013 * SEQUENCE. ITEMS IN THE CHAIN ARE ARRANGED IN DESCENDING ORDER OF 37800013 * PRIORITIES FROM THE TOP OF THE CHAIN. THE SUBR ACTS ON ALL CHAINS 38000013 * INCLUDING THE READY QUEUE. 38200013 * THE SUBR EXAMINES EACH ITEM ON THE CHAIN UNTIL IT FINDS EITHER 38400013 * AN ITEM WITH LOWER PRIORITY THAN THAT OF THE SEARCH ARGUMENT, OR THE 38600013 * LAST ITEM ON THE CHAIN (SIGNALLED BY PRIORITY 255). WHEN EITHER 38800013 * CONDITION IS MET, THE SUBR EXITS TO THE QUEUE INSERT SUBR. 39000013 * FOR THE PRIORITY SEARCH SUBROUTINE, FREG POINTS TO THE ITEM TO BE 39200013 * ORDERED,QREG POINTS INITIALLY TO THE HEAD OF A QUEUE AND THEREAFTER 39400013 * TO SUCCESSIVE ITEMS ON THE QUEUE, AND TREG POINTS TO THE ITEM THAT 39600013 * PRECEDES THE ITEM IN QREG. WHEN THE ITEM IN TREG HAS A LOWER PRI- 39800013 * ORITY THAN THE SEARCH ARGUMENT IN FREG, OR IS THE LAST ITEM ON THE 40000013 * CHAIN, THE SEARCH ARGUMENT IS TO BE LINKED UPWARD TO THE ITEM IN 40200013 * QREG, AND DOWNWARD TO THE ITEM IN TREG. 40400013 SPACE 40600013 PRIORITY L TREG,QKEY POINT TO ITEM ON QUEUE 40800013 CLI TPRI,255 PRIORITY 255 SIGNALS END OF CHAIN 41000013 BE LIFO IF FOUND,LINK ITEM AHEAD OF LAST. 41200013 CLC TPRI,FPRI IS PRI LOWER THAN QUEUED ITEM'S. 41400013 BC 10,SCAN NO -- GET NEXT ITEM ON QUEUE 41600013 * YES -- ITEM IN FREG LINKS INTO QUEUE 41800013 * BELOW THE ITEM IN QREG. 42000013 * 42200013 * FALL THRU TO QUEUE INSERT RTN 42400013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--QUEUE INSERT SUBROUTINE' 42600013 * QUEUE INSERT SUBROUTINE 42800013 * THIS IS A GENERALIZED SUBR THAT LINKS ITEMS INTO A CHAIN. IT IS 43000013 * APPLIED TO ALL CHAINS INCLUDING THAT OF THE READY QUEUE. WHEN THIS 43200013 * SUBR IS ENTERED, A REGISTER CONTAINS A POINTER TO THE LINK ADDR 43400013 * PORTION OF THE ITEM AT THE POINT IN THE CHAIN AT WHICH THE NEW ITEM 43600013 * IS TO BE INSERTED. A SECOND REGISTER HOLDS THE ADDRESS OF THE ITEM 43800013 * TO BE INSERTED. (THE POINT OF INSERTION IS THE HEAD OF THE CHAIN 44000013 * EXCEPT WHEN THIS SUBROUTINE IS ENTERED FROM THE PRIORITY SEARCH 44200013 * SUBR WHICH SELECTS THE INSERTION POINT ACCORDING TO THE ITEM'S 44400013 * PRIORITY.) THE SUBR PLACES THE OLD LINK ADDR IN THE NEW ITEM, 44600013 * REPLACES THE OLD LINK ADDR WITH THE NEW ITEM'S ADDR, AND EXITS TO THE 44800013 * QDISPATCH RTN (DISPATCH). 45000013 SPACE 45200013 LIFO MVC FLINK,QFAC LINK ADDRESS OF OLD ITEM TO NEW 45400013 IC TREG,QFAC-1 SAVE BYTE OF OLD LINK FIELD 45600013 ST FREG,QFAC-1 NEW ITEM ADDRESS TO OLD 45800013 STC TREG,QFAC-1 RESTORE BYTE OF OLD LINK FIELD 46000013 * 46200013 * FALL THRU TO DISPATCH RTN. 46400013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--DISPATCH SUBROUTINE' 46600013 * DISPATCH SUBROUTINE 46800013 * THIS SUBR PERFORMS THE PRIMARY INTERNAL MANAGEMENT 47000013 * FUNCTION WITHIN QTAM. EXCEPT FOR THOSE CASES IN 47200013 * WHICH ANOTHER SUBR IS ABLE TO DETERMINE THE SUBTASK 47400013 * TO BE ACTIVATED NEXT (AS, FOR EXAMPLE, WHEN THE WAIT 47600013 * SUBROUTINE FINDS THAT ELEMENTS ARE ALREADY AVAILABLE TO A 47800013 * SUBTASK REQUESTING ELEMENTS AND THAT THE DISPATCH SUBR 48000013 * CAN BE BYPASSED), THE DISPATCH SUBR MAINTAINS 48200013 * CONTINUITY BY RECEIVING CONTROL FROM A COMPLETED SUBTASK 48400013 * AND SELECTING ANOTHER SUBTASK WHICH IS TO RECEIVE CONTROL. 48600013 * THE DISPATCH SUBR EXAMINES THE ITEM AT THE HEAD 48800013 * OF THE READY QUEUE AND TAKES ONE OF FOUR COURSES OF 49000013 * ACTION, DEPENDING ON THE TYPE OF ITEM ENCOUNTERED. ITEMS 49200013 * THAT CAN APPEAR ON THE READY QUEUE ARE-- 49400013 * 1. QCB'S FOR WHICH THE HIGHEST-PRIORITY 49600013 * SUBTASK IS NOT WAITING FOR ELEMENTS (QCB KEY IS 2). 49800013 * 2. QCB'S WAITING FOR ELEMENTS(KEY IS 3). 50000013 * 3. ECB'S CONTAINING THE ADDR OF 50200013 * THE QCB TO WHICH THE ELEMENT HAS BEEN POSTED (KEY IS 0). 50400013 * 4. FULL STCBS, FOR WHICH THE KEY VALUE IS ALSO ZERO. 50600013 * THE FIRST WORD OF A FULL STCB CONTAINS THE ADDRESS 50800013 * OF THE QATTACH QCB. 51000013 * THE EFFECT OF THE APPEARANCE OF EACH TYPE AT THE HEAD 51200013 * OF THE READY QUEUE IS DESCRIBED BELOW. 51400013 SPACE 51600013 * QCB--NOTWAITING (KEY=2). 51800013 * WHEN THE ITEM AT THE HEAD OF THE READY QUEUE IS A 'NOT WAITING' 52000013 * QCB, CONTROL IS GIVEN TO THE FIRST (HIGHEST PRIORITY) 52200013 * SUBTASK REPRESENTED IN THE QCB'S STCB CHAIN AND THE QCB'S 52400013 * KEY IS SET TO 3. 52600013 SPACE 52800013 * QCB--WAITING (KEY 3). 53000013 * A 'WAITING' QCB AT THE HEAD OF THE READY QUEUE IS REMOVED FROM 53200013 * THE READY QUEUE (I.E., IS REPLACED BY THE ITEM IT LINKED TO) AND 53400013 * ITS KEY IS SET TO 1. A QCB WAITING FOR ELEMENTS CANNOT 53600013 * CONTEND FOR CONTROL; HOWEVER, IT WILL AUTOMATICALLY BE 53800013 * RETURNED TO THE READY QUEUE WHEN AN ELEMENT BECOMES AVAILABLE. 54000013 * AN EXCEPTION ARISES WHEN A SUBTASK REQUIRES MORE THAN 54200013 * ONE ELEMENT (FOR EXAMPLE, A SERIES OF BUFFERS) TO 54400013 * ACCOMPLISH ITS FUNCTION. WHEN WUCH A SUBTASK RECEIVES 54600013 * CONTROL, THE QCB WITH WHICH IT IS ASSOCIATED CONTINUES TO 54800013 * APPEAR AS 'WAITING' (KEY IS 3) UNTIL ALL REQUIRED 55000013 * ELEMENTS HAVE BEEN RECEIVED. BEFORE A WAITING QCB IS 55200013 * REMOVED, IT IS DETERMINED WHETHER THE QTAM SUBTASK FROM 55400013 * WHICH CONTROL WAS LAST RETURNED WAS ASSOCIATED WITH THAT 55600013 * QCB. IF IT WAS, THAT SUBTASK IS AGAIN GIVEN CONTROL. 55800013 * THIS CYCLE CONTINUES UNTIL THE SUBTASK FULFILLS ALL OF 56000013 * ITS REQUIREMENTS OR UNTIL THE SUBTASK EXHAUSTS THE 56200013 * QUEUE'S ELEMENT CHAIN. 56400013 SPACE 56600013 * ELEMENT CONTROL BLOCK. 56800013 * AN ECB (UNLESS ASSEMBLED AS AN ITEM IN THE READY QUEUE) 57000013 * APPEARS ON THE 57200013 * READY QUEUE AS A RESULT OF AN SVC 67, AS EXPLAINED BELOW, 57400013 * AND CONTAINS THE ADDRESS OF THE QCB FOR THE QUEUE TO 57600013 * WHICH THE ELEMENT HAS BEEN POSTED. AN ELEMENT APPEARING 57800013 * AT THE TOP OF THE READY QUEUE IS IMMEDIATELY REPLACED BY 58000013 * THE NEXT ITEM ON THE READY QUEUE. HOWEVER, THE QCB 58200013 * POINTER IN THE ECB IS RETAINED. THAT QCB IS THEN TREATED AS THOUGH 58400013 * IT, RATHER THAN AN ELEMENT ASSOCIATED WITHIT, HAD BEEN ENCOUNTERED; 58600013 * ITS HIGHEST PRIORITY SUBTASK IS ACTIVATED, AND ITS KEY IS SET TO 3. 58800013 * THIS CONVENTION HAS SEVERAL SIGNIFICANT ASPECTS... 59000013 * 1. IT IS THE MEANS BY WHICH A REMOVED 'WAITING' QCB IS 59200013 * RETURNED TO THE READY QUEUE. 59400013 * 2. IT ILLUSTRATES THE CASE WHERE THE ACTIVE QCB -- THAT 59600013 * IS, THE QCB WITH WHICH THE ACTIVE SUBTASK CONTROL 59800013 * BLOCK IS ASSOCIATED -- IS NOT NECESSARILY AT THE 60000013 * HEAD OF THE READY QUEUE. 60200013 * 3. IT EXPLAINS THE FACT THAT AN ECB NEED NOT BE PHYSICALLY CHAINED 60400013 * INTO A QCB TO BECOME ASSOCIATED WITH THAT QCB. SPECIFICALLY, IT 60600013 * ENSURES THAT AN ELEMENT IS IMMEDIATELY ACTED UPON, EXCEPT IN 60800013 * THE CASE WHERE THE QUEUE INVOLVED ALREADY HAS AT 61000013 * LEAST ONE OTHER 'REAL' ELEMENT AND IS ALREADY 61200013 * CONTENDING FOR COMPUTING TIME. 61400013 SPACE 61600013 * FULL SUBTASK CONTROL BLOCK 61800013 * THIS IS THE ONLY FORM OF STCB THAT APPEARS ON THE READY QUEUE. 62000013 * ITS APPEARANCE AT THE HEAD OF THE READY QUEUE HAS EXACTLY THE SAME 62200013 * EFFECT AS THE APPEARANCE THERE OF A 'NOT WAITING' (KEY IS 2) QCB 62400013 * WITH THIS STCB AT THE HEAD OF ITS STCB CHAIN, THE SUBTASK 62600013 * IS ACTIVATED AND THE KEY OF THE QCB WITH WHICH IT IS 62800013 * ASSOCIATED (QATTACH) IS SET TO 3. 63000013 * THE MECHANISM BY WHICH THIS IS ACCOMPLISHED IS AS FOLLOWS... 63200013 * 1. LOCATION READY CONTAINS A POINTER TO THE STCB; THIS 63400013 * SITUATION IS THE PHYSICAL COUNTERPART OF THE STCB'S 63600013 * BEING AT THE HEAD OF READY QUEUE. 63800013 * 2. THE STCB ITSELF HAS THE APPEARANCE (TO THE QTAM 64000013 * CONTROL ROUTINES) OF AN ELEMENT. ITS QCB ADDR IS QATTACH. 64200013 * 3. QATTACH IS A STORAGE LOCATION EQUIVALENT TO READY 64400013 * MINUS 8 BYTES. IT ALSO APPEARS TO BE THE FIRST WORD 64600013 * OF A 'NOT WAITING' QCB. 64800013 * 4. SINCE THE STCB IS APPARENTLY AN ECB ASSOCIATED 65000013 * WITH A 'NOT WAITING' QCB, THE FIRST STCB IN THAT QCB'S CHAIN 65200013 * SHOULD BE SELECTED FOR ACTIVATION. THE ADDR OF THE FIRST STCB 65400013 * IS TO BE FOUND IN THE THIRD FULLWORD OF THE QCB. 65600013 * 5. THE THIRD FULLWORD OF THE QATTACH WHICH APPEARS AS A 65800013 * QCB IS THE LOCATION READY. THEREFORE, THE FULL 66000013 * SUBTASK, WHOSE ADDRESS IS AT READY, IS SELECTED FOR CONTROL. 66200013 SPACE 66400013 * FETCH HEAD OF READY QUEUE 66600013 SPACE 2 66800013 DISPATCH MVI QATTACH,2 RESET QATTACH QCB TO NOT WAITING 67000013 L FREG,READY POINT FREG TO ITEM AT RDY Q HEAD 67200013 LA QREG,FKEY POINT QREG TO 1ST WORD OF READY ITEM 67400013 CLC READY+1(3),QSAVE+1 MAY THIS READY ITEM BE DISP. 67600013 B DISPSUBR TO SUBROUTINE TO SEE IF ITEM CAN BE A49840 67800021 * DISPATCHED. IF SUBROUTINE GOES TO 'EXIT', ITEM WILL NOT A49840 68000021 * BE DISPATCHED BECAUSE ONE OF 3 CASES EXIST AS FOLLOWS A49840 68200021 * 1. ENTRY TO QDISPATCH WAS FROM AN 68400013 * SVC AND THIS READY ITEM IS THE 68600013 * DUMMY END ITEM. 68800013 * 2. ENTRY TO QDISPATCH WAS FROM AN 69000013 * ASYNCHRONOUS INTERRUPT AND THIS 69200013 * IS THE QUEUE LAST DISPATCHED ON 69400013 * AN SVC ENTRY TO QDISPATCH. 69600013 * 3. MCP IS ABENDING A49840 69700021 CLI QKEY,2 IS ITEM A QCB -- KEY EQ 2 OR 3 69800013 BC 10,A BR WHEN KEY EQUAL/HIGHER THAN 2 70000013 * NO -- CONSIDER IT AN ELEMENT 70200013 SPACE 70400013 * 70600013 * REMOVE FOLDED QCB FROM READY QUEUE WHEN ENABLED SUBTASK IS WATING 70800013 * 71000013 CL QREG,QFAC-1 IS ELEMENT POST TO ITSELF 71200013 BNE DISABLE BRANCH NO 71400013 MVC READY+1(3),FLINK REMOVE ELEMENT FROM READY QUEUE 71600013 L TREG,QTRAN LOAD STCB ADDRESS 71800013 CLI TFILL,0 IS STCB FULL STCB (SVRB) 72000013 LA TREG,QATTACH QATTACH ADDRESS IN CASE OF BR. 72200013 BE WAIT BRANCH TO PUT STCB ON THE A36508 72400020 * READY QUEUE. 72600013 * 72800013 * FACILITY AT HEAD -- FETCH QUEUE 73000013 * 73200013 DISABLE EQU * 73400013 L QREG,FKEY GET ECB'S QCB ADDR 73600013 CLI QKEY,2 IS ECB'S QCB ALREADY ON RDY Q 73800013 BC 10,A BRANCH IF YES 74000013 SPACE 74200013 * 74400013 * ITEM IS AN ELEMENT POINTING TO A QCB NOT ON THE READY QUEUE. 74600013 * 74800013 MVC QPRI(4),FPRI REMOVE ELEMENT FROM TOP OF READY Q 75000013 ST QREG,READY REPLACE ELEMENT WITH ITS QCB 75200013 * BRANCH TO BD NOW UNCONDITIONAL 75400013 SPACE 75600013 A BC 12,BD THIS INSTRUCTION IS A BRANCH ON QCB 75800013 * KEY EQ 2 WHEN REACHED VIA A BRANCH 76000013 SPACE 76200013 * 76400013 * ITEM IS A WAITING QCB OR AN ELEMENT POINTING TO A WAITING QCB 76600013 * 76800013 MVC READY+1(3),FLINK REMOVE ITEM FROM HEAD OF READY QUEUE 77000013 NI FKEY,X'FD' IF ITEM IS A QCB, THIS SETS KEY=2 (NOT WAIT) 77200013 BC 4,DISPATCH BRANCH IF QCB 77400013 * OTHERWISE, ITEM IS AN ELEMENT POINT- 77600013 * ING TO A QCB WITH A WAITING SUBTASK 77800013 * 78000013 * FALL THRU TO EXIT SELECT RTN WITH ELEMENT REMOVED FROM HEAD OF RDY Q 78200013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--EXIT SELECT SUBROUTINE' 78400013 * EXIT SELECT SUBROUTINE 78600013 * THIS SUBR ACTIVATES SUBTASKS REPRESENTED BY 78800013 * TRUNCATED STCB'S, OR FALLS THROUGH TO THE EXIT INTERFACE 79000013 * SUBROUTINE IF THE STCB IS NOT TRUNCATED. 79200013 * THE FIRST BYTE OF A TRUNCATED STCB IS A BRANCH 79400013 * MODIFIER OF THE FORM (ENTRYPT-NRET), WHERE ENTRYPT IS THE 79600013 * ADDR OF THE DESIRED ENTRY POINT. NRET IS THE LOCATION 79800013 * FROM WHICH THE BRANCH OFFSET IS APPLIED. WHEN THE EXIT 80000013 * SELECT SUBR ENCOUNTERS A NON-ZERO RETURN CODE, IT 80200013 * COMPUTES THE BRANCH ADDRESS AND BRANCHES TO THE COMPUTED 80400013 * ENTRY POINT. 80600013 LR TREG,QREG QUEUE ADDRESS TO TREG 80800013 SPACE 2 81000013 RETURNX ST TREG,FKEY 81200013 BD MVI QKEY,3 SET QCB'S KEY TO 'WAITING' 81400013 RETURN L TREG,QTRAN GET STCB ADDRESS FROM QCB 81600013 SR X,X CLEAR WORK REG 81800013 IC X,TFILL GET STCB,S RETURN CODE 82000013 LTR X,X ZERO CODE SHOWS AUGMENTED SUBTASK 82200013 BNZ NRET(X) BRANCH TO NON-AUGMENTED SUBTASK IN IGG019NG 82400013 * 82600013 * FALL THRU TO EXIT INTERFACE RTN IF ITEM A FULL STCB. 82800013 TITLE 'IECKQQ01 (CONTROL PROGRAM)--EXIT INTERFACE SUBROUTINE' 83000013 * EXIT INTERFACE SUBROUTINE 83200013 * THIS SUBR IS ENTERED TO PROCESS FULL STCB'S. 83400013 * BEFORE TAKING ANY OTHER ACTION, THE SUBR DETERMINES 83600013 * WHETHER THE SUBTASK IS BEING SCHEDULED FOR ACTIVATION 83800013 * BECAUSE IT WAS REPRESENTED IN THE STCB CHAIN OF A WAITING 84000013 * QCB FOR WHICH AN ELEMENT HAS BEEN ENCOUNTERED. IF THIS 84200013 * CONDITION EXISTS, THE ELEMENT'S ADDR IS PLACED IN THE 84400013 * PARAMETER REGISTER IN THE SAVE AREA OF THE FULL STCB. 84600013 * 84800013 * 85000013 * A BRANCH IS TAKEN TO THE O/S POST ROUTINE TO POST COMPLETION 85200013 * IN THE ECB OF THE STCB (SVRB) BEING DISPATCHED. THE SUBR THEN CAUSES 85400013 * ONE OF TWO EXITS TO BE TAKEN DEPENDING ON THE MODE OF ENTRY, (SVC 85600013 * OR ASYNCHRONOUS INTERRUPT) TO THE QDISPATCH SUBR. 85800013 * 86000013 * 1. IF ENTRY TO QDISPATCH WAS AS THE RESULT OF AN ASYNCHRONOUS 86200013 * INTERRUPT A RETURN IS MADE TO IOS VIA A BRANCH. 86400013 * 86600013 * 2. IF ENTRY TO QDISPATCH WAS FROM AN SVC A WAIT IS ISSUED ON THE 86800013 * ECB OF THE ENTRY SVRB. AFTER THE WAIT IS SATISFIED A RETURN IS 87000013 * EFFECTED TO THE ROUTINE WHICH ISSUED THE SVC. 87200013 SPACE 2 87400013 * 87600013 * STORE RETURN PARAMETER IF WAITING STCB BEING DISPATCHED 87800013 * 88000013 CL FREG,READY WAS ENTRY TO THIS ROUTINE THE 88200013 * RESULT OF AN ELEMENT FOUND ON 88400013 * THE READY QUEUE. 88600013 BE *+8 BRANCH IF ENTRY DUE TO QCB OR 88800013 * STCB FOUND ON READY QUEUE. 89000013 ST FREG,XRBREG+4 STORE RETURN PARAMETER 89200013 ST QREG,QSAVE SAVE THIS QUEUE ADDRESS 89400013 * 89600013 * POST ECB COMPLETE 89800013 * 90000013 MVC QTRAN+1(3),TLINK REMOVE STCB FROM QUEUE 90200013 LA 11,XRBQ LOAD ECB ADDRESS FOR POST 90400013 LNKLOOP TM XSTZB+1,X'80' TEST FOR LINK FIELD = TCB 90600013 L TREG,XRBLNK-1 LOAD RB LINK ADDRESS 90800013 BC 8,LNKLOOP BRANCH NOT TCB ADDRESS 91000013 LR X,BREG SAVE BASE OF QQ01 91200013 L 15,POSTCON LOAD POST ENTRY POINT 91400013 LR BREG,TREG LOAD TCB ADDRESS FOR POST 91600013 BALR 14,15 TO THE POST ROUTINT 91800013 LR BREG,X RESTORE QQ01 BASE 92000013 EXIT CLI IOSSAVE,255 ENTRY FROM SVC 92200013 BNE REENT BRANCH ENTRY FROM I/O INTERRUPT 92400013 * 92600013 * WAIT ON ENTRY RB 92800013 * 93000013 L TREG,16 LOAD CVT ADDRESS 93200013 L TREG,0(TREG) TCB TABLE ADDRESS 93400013 L TREG,4(TREG) LOAD OLD TCB ADDRESS 93600013 L TREG,0(TREG) LOAD ADDRESS OF ENTRY RB 93800013 WAIT 1,ECB=XRBQ 94000013 * 94200013 * RETURN TO ROUTINE WHICH ISSUED THE SVC 94400013 * 94600013 LM 0,15,XRBREG LOAD CALLERS REGISTERS 94800013 SVC 3 95000013 * 95200013 * RETURN TO IOS 95400013 * 95600013 REENT LM 14,13,IOSSAVE RELOAD REGISTERS 95800013 BR 14 RETURN 96000013 POSTCON DC V(IEA0PT01) ENTRY ADDRESS FOR OS POST RT. 96200013 IOSSAVE DS 16A 96400013 DISPSUBR BE EXIT CASE 1 OR 2, DO NOT DISPATCH A49840 96420021 L TCBREG,0(13) LPSQ ADDRESS A49840 96440021 L TCBREG,288(TCBREG) MCP TCB ADDRESS A49840 96460021 TM 29(TCBREG),X'80' MCP ABENDING? A49840 96480021 BO EXIT YES, DO NOT DISPATCH ITEM A49840 96500021 B DISPATCH+22 NO, RETURN TO DISPATCH A49840 96520021 MEND 96600013 ./ ADD SSI=01030080,SOURCE=1,NAME=CWRITE MACRO 02000000 &NAME CWRITE &RESP 04000000 LCLA &A,&OPNUM 06000000 LCLB &CHRNUM,&SETRSP 08000000 LCLC &PARAM 10000000 &A SETA 4 12000000 &OPNUM SETA N'&SYSLIST NUMBER OF OPERANDS 14000000 AIF (&OPNUM EQ 0).CONT NO OPERAND 16000000 AIF (&OPNUM GT 1).CHECK MORE THAN ONE OPERAND SPEC 18000000 &CHRNUM SETB (K'&RESP GT 1) 20000000 AIF (&CHRNUM).ERR2 OPERAND WITH MORE THAN 1 CHAR 22000000 &PARAM SETC '&RESP' 24000000 &SETRSP SETB ('&PARAM' EQ 'R') 26000000 AIF (NOT &SETRSP).ERR3 28000000 &A SETA 6 30000000 .CONT ANOP 32000000 CNOP 0,4 34000000 &NAME OI 4(15),X'&A' SET WRITE/RESP FLAG 36000000 BAL 1,*+8 LOAD ADD OF NEXT IN REG 1 38000000 .PRMLST DC F'0' FULL WORD 40000000 ST 15,0(0,1) STORE ADDRESS IN PARM LIST 42000000 L 15,IHKYYLAD GET ENTRY POINT ADDRESS 44000000 BALR 14,15 LINK TO LINE ADMINISTRATOR 46000000 MEXIT 48000000 .CHECK AIF (N'&SYSLIST(1) EQ 0).ERR0 FIRST OPERAND OMITTED 50000000 MNOTE 7,'MORE THAN ONE OPERAND SPECIFIED' 52000000 MEXIT 54000000 .ERR2 MNOTE 7,'SINGLE OPERAND CONSISTS OF MORE THAN ONE CHAR' 56000000 MEXIT 58000000 .ERR3 MNOTE 7,'SINGLE OPERAND SPECIFIED WRONG,-SHOULD BE CHAR R' 60000000 MEXIT 62000000 .ERR0 MNOTE 7,'MORE OPERANDS SPECIFIED AND FIRST OPER OMITTED' 64000000 MEND 66000000 ./ ADD SSI=01012176,SOURCE=1,NAME=DCHB MACRO 00800000 &NAME DCHB &DSECT=YES 01600000 AIF ('&DSECT' EQ 'NO').D1 02400000 WORKAREA DSECT 03200000 .D1 ANOP 04000000 DCHBWRK DS 0CL131 04800000 SPACE 05600000 DCHBCUU DS CL2 LINE ADDR: FORMAT 2 BYTE HEX 06400000 SPACE 07200000 DCHBDESC DC X'00' 1 BYTE DESCRIPTOR 08000000 * X'00' DCHB FOR TCU 08800000 * X'01' FIRST TERMINAL ON LINE 09600000 * X'FF' LAST TERMINAL ON LINE 10400000 SPACE 11200000 DCHBTCU DS CL4 12000000 SPACE 12800000 SPACE 13600000 DCHBNAME DS CL8 TERMINAL NAME 14400000 DCHBTTYP DS CL4 TERMINAL TYPE (E.G.F1F0F5F0) 15200000 SPACE 16000000 DCHBADAP DS CL1 ADAPTER TYPE 16800000 * X'10' IBM I 17600000 * X'20' IBM II 18400000 * X'30' IBM TTY 19200000 * X'40' TTY I 20000000 * X'50' TTY II 20800000 * X'60' WTC TTY 21600000 * X'70' SDA I 22400000 * X'80' IBM III 23200000 * X'90' SDA II 24000000 SPACE 24800000 DCHBTYPE DS CL1 LINE TYPE 25600000 * X'01' LEASED POINT TO POINT 26400000 * X'02' LEASED MULTIDROP 27200000 * X'03' SWITCHED NO AUTO DIAL 28000000 * X'04' SWITCHED AUTO DIAL 28800000 * X'05' LOCAL 29600000 SPACE 30400000 DCHBCODE DS CL1 LINE CODE 31200000 * X'01' 6 BIT BCD 32000000 * X'02' INT TEL ALPHABET 2 32800000 * X'03' CODE SHIFTED BAUDOT 33600000 * X'04' 8 LEVEL TWX 34400000 * X'05' USASCII 8 35200000 * X'06' FOUR OUT OF EIGHT CODE 36000000 * X'07' EBCDIC 36800000 * X'08' TRANSCODE 37600000 SPACE 38400000 DCHBENAB DS CL5 ENABLING SEQUENCE 39200000 * COMMAND CODES TO ENABLE ADAPTER 40000000 * COMMANDS ARE IN SEQUENCE 40800000 * X'40' INDICATES NO ENABLE SEQUENCE 41600000 * FOR THIS ADAPTER 42400000 * X'00' IS END OF SEQUENCE 43200000 SPACE 44000000 DCHBPOL# DS CL1 NO. OF POLLING CHARACTERS 44800000 SPACE 45600000 DCHBPOLL DS CL7 POLL CHARACTERS 46400000 SPACE 47200000 DCHBC# DS CL1 NO. OF COMPONENT SELECTION CHARACTER 48000000 DCHBCOMP DS CL10 COMPONENT SELECTION CHARACTERS 48800000 SPACE 49600000 DCHBD# DS CL1 IF AUTODIAL NO. OF DIAL DIGITS 50400000 SPACE 51200000 DCHBDIAL DS CL20 DIAL DIGITS 52000000 SPACE 52800000 DCHBCONT DS CL30 LINE CONTROL CHARACTERS 53600000 * FIRST 8 BYTES ARE OFFSET TO BYTE 54400000 * COUNT OF CHARACTERS. AFTER BYTE 55200000 * COUNT ARE CONTROL CHARACTERS 56000000 * BYTE 1 OFFSET TO EOT SEQ 56800000 * BYTE 2 OFFSET TO EOA SEQ 57600000 * BYTE 3 OFFSET TO EVEN ACK SEQ 58400000 * BYTE 4 OFFSET TO ODD ACK SEQ 59200000 * BYTE 5 OFFSET TO NACK SEQ 60000000 * BYTE 6 OFFSET TO PAD CHARACTERS 60800000 * BYTE 7 & 8 UNDEFINED 61600000 * X'00' MEANS NO SEQ FOR THIS FUNCTION 62400000 SPACE 63200000 DCHBBS# DS CL1 NUMBER OF BY SYNC ID CHARACTERS 64000000 SPACE 64800000 DCHBBSID DS CL15 BI SYNC ID 65600000 SPACE 66400000 DSL# DS CL1 67200000 SPACE 68000000 DSEL DS CL7 68800000 SPACE 69600000 SPACE 70400000 DCHBDEV DS CL10 DEVICE CONFIGURATOR BYTES 71200000 EJECT 72000000 * 72800000 * DC AND DS'S 73600000 * 74400000 #TABLE DS F 75200000 TNTABLE DS F 76000000 INVADDR DS F 76800000 DCTADDR DS F 77600000 AVTADDR DS F 78400000 SCTADD DS F 79200000 TERTABLE DS F 80000000 WORK1 DS F 80800000 WORK2 DS H 81600000 WORK3 DS 0CL41 82400000 DC C'PLEASE ENTER TYPE OF TERMINAL AT ' 83200000 TERNAME DS CL8 84000000 FLAGBYTE DC X'00' 84800000 SADWORK DS CL1 85600000 LINEFLAG DS CL1 86400000 CODEFLAG DS CL1 87200000 BLANKS DC 8C' ' 88000000 LINEAD DS CL2 88800000 COMFLG DC X'00' 89600000 MEND 90400000 ./ ADD SSI=01012882,SOURCE=1,NAME=DCHBD MACRO 01000000 &NAME DCHBD &DSECT=YES 02000000 AIF ('&DSECT' EQ 'NO').D1 03000000 DCHBWRK DSECT 04000000 .D1 ANOP 05000000 SPACE 06000000 DCHBCUU DS CL2 LINE ADDR: FORMAT 2 BYTE HEX 07000000 SPACE 08000000 DCHBDESC DC X'00' 1 BYTE DESCRIPTOR 09000000 * X'00' DCHB FOR TCU 10000000 * X'01' FIRST TERMINAL ON LINE 11000000 * X'FF' LAST TERMINAL ON LINE 12000000 SPACE 13000000 DCHBTCU DS CL4 TCU TYPE IN EBCDIC 14000000 SPACE 15000000 SPACE 16000000 DCHBNAME DS CL8 TERMINAL NAME 17000000 DCHBTTYP DS CL4 TERMINAL TYPE (E.G.F1F0F5F0) 18000000 SPACE 19000000 DCHBADAP DS CL1 ADAPTER TYPE 20000000 * X'10' IBM I 21000000 * X'20' IBM II 22000000 * X'30' IBM TTY 23000000 * X'40' TTY I 24000000 * X'50' TTY II 25000000 * X'60' WTC TTY 26000000 * X'70' SDA I 27000000 * X'80' IBM III 28000000 * X'90' SDA II 29000000 SPACE 30000000 DCHBTYPE DS CL1 LINE TYPE 31000000 * X'01' LEASED POINT TO POINT 32000000 * X'02' LEASED MULTIDROP 33000000 * X'03' SWITCHED NO AUTO DIAL 34000000 * X'04' SWITCHED AUTO DIAL 35000000 * X'05' LOCAL 36000000 SPACE 37000000 DCHBCODE DS CL1 LINE CODE 38000000 * X'01' 6 BIT BCD 39000000 * X'02' INT TEL ALPHABET 2 40000000 * X'03' CODE SHIFTED BAUDOT 41000000 * X'04' 8 LEVEL TWX 42000000 * X'05' USASCII 8 43000000 * X'06' FOUR OUT OF EIGHT CODE 44000000 * X'07' EBCDIC 45000000 * X'08' TRANSCODE 46000000 SPACE 47000000 DS CL5 SPARE 50000000 SPACE 54000000 DCHBPOL# DS CL1 NO. OF POLLING CHARACTERS 55000000 SPACE 56000000 DCHBPOLL DS CL7 POLL CHARACTERS 57000000 SPACE 58000000 DCHBC# DS CL1 NO. OF COMPONENT SELECTION CHARACTER 59000000 DCHBCOMP DS CL10 COMPONENT SELECTION CHARACTERS 60000000 SPACE 61000000 DCHBD# DS CL1 IF AUTODIAL NO. OF DIAL DIGITS 62000000 SPACE 63000000 DCHBDIAL DS CL20 DIAL DIGITS 64000000 SPACE 65000000 DCHBCONT DS CL30 LINE CONTROL CHARACTERS 66000000 * FIRST 8 BYTES ARE OFFSET TO BYTE 67000000 * COUNT OF CHARACTERS. AFTER BYTE 68000000 * COUNT ARE CONTROL CHARACTERS 69000000 * BYTE 1 OFFSET TO EOT SEQ 70000000 * BYTE 2 OFFSET TO EOA SEQ 71000000 * BYTE 3 OFFSET TO EVEN ACK SEQ 72000000 * BYTE 4 OFFSET TO ODD ACK SEQ 73000000 * BYTE 5 OFFSET TO NACK SEQ 74000000 * BYTE 6 OFFSET TO PAD CHARACTERS 75000000 * BYTE 7 & 8 UNDEFINED 76000000 * X'00' MEANS NO SEQ FOR THIS FUNCTION 77000000 SPACE 78000000 DCHBBS# DS CL1 NUMBER OF BY SYNC ID CHARACTERS 79000000 SPACE 80000000 DCHBBSID DS CL15 BI SYNC ID 81000000 DS CL8 SPARE 84000000 SPACE 87000000 DCHBDEV DS CL10 DEVICE CONFIGURATOR BYTES 88000000 MEND 89000000 ./ ADD SSI=01030071,SOURCE=1,NAME=DEBDS MACRO 02000000 DEBDS 04000000 * 06000000 * DATA EXTENT BLOCK DEFINITION 08000000 * 10000000 DEBDS DSECT , 12000000 DEBNMSUB DS 0C . 14000000 DEBTCBAD DS F . TASK CONTROL BLOCK POINTER 16000000 DEBAMLNG DS 0C . 18000000 DEBDEBAD DS F . DEB CHAIN 20000000 DEBOFLGS DS 0C . OPEN FLAGS 22000000 DEBIRBAD DS F . ASI IRB POINTER 24000000 DEBOPATB DS 0C . 26000000 DEBSYSPG DS F . 28000000 DEBNMEXT DS 0C . NUMBER OF EXTENTS 30000000 DEBUSRPG DS F . 32000000 DEBPRIOR DS 0C . 34000000 DEBECBAD DS F . 36000000 DEBPROTG DS 0C . 38000000 DEBDEBID DS 0C . 40000000 DEBDCBAD DS F . DCB POINTER 42000000 DEBEXSCL DS 0C . 44000000 DEBAPPAD DS F . APPENDAGE VECTOR TABLE POINTER 46000000 DEBDVMOD DS 0C . FILE MASK 48000000 DEBUCBAD DS F . USB POINTER 50000000 DS H . 52000000 DEBSTRCC DS H . STARTING CYLINDER 54000000 DEBSTRHH DS H . STARTING HEAD 56000000 DEBENDCC DS H . LAST CYLINDER 58000000 DEBENDHH DS H . LAST HEAD NUMBER 60000000 DEBNMTRK DS H . NUMBER OF TRACKS IN THIS EXTENT 62000000 * 64000000 MEND 66000000 ./ ADD SSI=02012982,SOURCE=1,NAME=DFINDATA MACRO 02000015 &NAME DFINDATA 04000015 &NAME DSECT 06000015 DS 0D 08000015 DF EQU * 10000015 DFSAVE13 DS F 12000015 DFRECB DS F REPLY ECB 14000015 DFRPLY DS CL121 REPLY BUFFER 16000015 DFFF DC X'FF' POS.WILL CONTAIN FF TO FORCE 18000015 * UNEQUAL COMPARES ON SYNTAX. 20000015 * IS BASED ON DEPENDENCY THAT 22000015 * MAST SCHED WILL TRT REPLY TO 24000015 * INSURE ONLY PRINTABLE CHARACS. 26000015 DFSTAT DS C STATUS BYTE 28000015 DFEND EQU X'80' INTERNAL INDICATORS 30000015 DFLIST EQU X'40' FOR 32000015 DFCLASS EQU X'20' END,LIST & CLASS PARAMETERS 34000015 DFMULT EQU X'10' MULTIPLESUBPARM INDICATOR 36000015 DFEOB EQU X'08' EOB REACHED INDIC 38000015 DFCHNG EQU X'04' 40000015 DFLAST EQU X'02' INDIC LAST PARM SPECIFIED 42000015 DFACTIV EQU X'01' PARTITION CURRENTLY ACTIVE 44000015 DFDSIZ DS CL2 -DATA AREA SIZE 46000015 DFPMAX DS C MAXIMUM PARTITION NUMBER 48000015 DFXXA DS C TIME SLICE STATUS 48300017 TLIST EQU X'80' TIME SLICE LIST REQUEST 48600017 DFTSLC EQU TLIST 48900017 TCANCEL EQU X'40' CANCEL TIME SLICE 49200017 TPCHNG EQU X'20' CHANGE TIME SLICE PARTITIONS 49500017 TVCHNG EQU X'10' CHANGE TIME SLICE VALUE 49800017 TSACT EQU X'08' TIME SLICE ACTIVE 50100017 DFRES DS C INTRA-MODULAR STATUS BITS 50400017 DFIDOFP0 DS H ID OF P0-DEPENDS ON SYSGEN OPTS I250 50500000 DFSPARE DS C RESERVED I250 50600000 DFSYSNDX DS C 4 TIMES THE NO OF SYSGENED TCBS I250 50700000 * THE FOLLOWING 2 FIELDS ARE USED BY DFIN3, 8, AND B I250 50800000 DFTABR9 DS H TABLE INDEX FOR TCB IN REG 9 I250 50900000 DFTABR10 DS H TABLE INDEX FOR TCB IN REG 10 I250 51000000 DFTMSL DS D TIME SLICE DATA 51200015 DFTAB DS 0D TABLE OF PARTITION INFORMAT&ON. 52000015 * UP TO 52 ENTRIES, EACH ENTRY. 54000015 * DESCRIBED LIKE- 56000015 DFWKAREA DS 0D TEMPORARY WORK AREA 56300017 WHSIZE DS H HSS SIZE 56600017 WLCSIZE DS H LCS SIZE 56900017 WSTAT DS C STATUS 57200017 WCLASS DS 3C CLASS FOR PARTITION 57500017 PSIZE DS H HSS SIZE 59500017 PLCSIZE DS H LCS SIZE 61500017 PSTAT DS C PARTITION STATUS 63500017 PEND EQU X'80' LAST ENTRY INDICATOR 65500017 PLAST EQU X'40' LOWEST ACTIVE TCB 67500017 PCHNG EQU X'20' PARTITION BEING CHANGED 69500017 PCRNT EQU X'10' CHANGED BY REPLY BEING SCANNED 71500017 PSCSZ EQU X'08' ON = LARGE SIZE PARTITION 73500017 PPSIZ EQU X'04' SIZE STORED INDICATOR 75500017 PPCLS EQU X'02' CLASS,RDR,WTR CHANGE 77500017 PACTIVE EQU X'01' PARTITION CURRENTLY ACTIVE 79500017 PCLASS DS CL3 CLASSES,R OR W. 82000015 ORG PSIZE 84000017 DS 52CL8 86000015 DFTBSIZ EQU *-DF 88000015 RPLYSZ EQU L'DFRPLY LENGTH ATTRIBUTE OF REPLY BUF. 90000015 MEND 92000015 ./ ADD SSI=01010852,SOURCE=1,NAME=DIAG MACRO 01000000 DIAG &GETDEB=,&MOVEDEB=,&FREEDEB=,&DEBADR=, *01600000 &SYSTEST=,&GETUCB=,&MCT=,&START=,&END=,&LENGTH=,&ENTRY= 01900000 LCLB &X 02200000 LCLC &A,&B 02500000 * 03000000 * INTERFACE SVC 59 LEVEL 1 04000000 * 03/26/71 04500000 AIF ('&GETDEB' EQ '2').DIAG1 05000000 AIF ('&GETDEB' EQ 'ACCESS').DIAG1A 06000000 AIF ('&MOVEDEB' EQ '1').DIAG2 07000000 AIF ('&MOVEDEB' EQ 'ACCESS').DIAG2A 08000000 AIF ('&FREEDEB' EQ '2').DIAG3 09000000 AIF ('&FREEDEB' EQ 'ACCESS').DIAG3A 10000000 AIF ('&SYSTEST' EQ 'YES').DIAG4 11000000 AIF ('&GETUCB' EQ 'YES').DIAG5 11500000 &X SETB (1) 12000000 AGO .MCTA 12500000 .DIAG1 ANOP 13000000 * ISSUE GETMAIN FOR DEB 14000000 * 15000000 LA R1,GETDEB . GET FUNCTION CODE 16000000 LA R0,DIAGPL0 . GET PARAMETER LIST ADDRESS 17000000 SVC 59 . GO GETMAIN 18000000 ST R0,PRIDEBA . PUT PRIMARY DEB ADDRESS IN DCB 19000000 MVI PRIDEBA,X'0C' . 20000000 LA R1,64 . BUMP R1 TO 20600000 AR R0,R1 . SECOND DEB 21200000 ST R0,SECDEBA . PUT SECONDARY DEB ADDRESS IN DCB 22000000 MVI SECDEBA,X'0C' . 23000000 AGO .MEND 24000000 .DIAG1A ANOP 25000000 * ISSUE GETMAIN FOR ACCESS METHOD DEB 26000000 * 27000000 LA R1,GETDEB . GET FUNCTION CODE 28000000 LA R0,DIAGPL0 . GET PARAMETER LIST ADDRESS 29000000 SVC 59 . 30000000 ST R0,CBACDEBA . SAVE DEB ADDRESS 31000000 AGO .MEND 32000000 .DIAG2 ANOP 33000000 * MOVE DEB TO PROTECTED CORE 34000000 * 35000000 MVC DIAGPL4+1(3),DCBDEBAD . PUT DEB ADDRESS IN PARM LIST 36000000 LA R1,DEBNMSUB . PUT ADDRESS OF DEB 37000000 ST R1,DIAGPL0 . WORK AREA IN PARAMETER LIST 38000000 LA R1,MOVEDEB . GET FUNCTION CODE 39000000 LA R0,DIAGPL0 . GET PARAMETER LIST ADDRESS 40000000 SVC 59 . 41000000 XC DEBDEBAD(3),DEBDEBAD CLEAR DEB WORKAREA QUEUE POINTER 41200000 OI CBTCNTF1,FREEDEB . SET FREE DEB ON TERMINATE FLAG 41500000 AGO .MEND 42000000 .DIAG2A ANOP 43000000 * MOVE ACCESS METHOD DEB TO PROTECTED CORE 44000000 * 45000000 MVC DIAGPL4(4),CBACDEBA . PUT DEB ADDRESS IN PARM LIST 46000000 LA R1,&DEBADR . PUT ADDRESS OF DEB 47000000 ST R1,DIAGPL0 . WORK AREA IN PARAMETER LIST 48000000 LA R1,MOVEDEB . GET FUNCTION CODE 49000000 LA R0,DIAGPL0 . GET PARAMETER LIST ADDRESS 50000000 SVC 59 . 51000000 OI CBTCNTF1,FREEDEB . SET FREE DEB ON TERMINATE FLAG 51500000 AGO .MEND 52000000 .DIAG3 ANOP 53000000 .DIAG3A ANOP 62000000 * REMOVE DEB'S FROM TASK QUEUE 63000000 * 64000000 LA R0,DIAGPL0 . GET PARAMETER LIST ADDRESS 65000000 L R1,FREECODE . SET FUNCTION CODE IN REG 1 65600000 B SVC59 . GO EXECUTE SVC INSTRUCTION 66200000 FREECODE DS 0F . 66800000 DC X'00008014' . FREEDEB FUNCTION CODE 67400000 SVC59 EQU * 68000000 SVC 59 . 69000000 AGO .MEND 70000000 .DIAG4 ANOP 71000000 * TEST OPERATING SYSTEM TYPE 72000000 * 73000000 L R1,16 . GET CVT ADDRESS 74000000 TM 116(R1),X'10' . IS SYSTEM MVT? 75000000 BO RES001 . YES 76000000 OI TOTEFLG2,OSMFT . YES: SET MFT FLAG 78000000 B RES002 . 79000000 RES001 EQU * 80000000 OI TOTEFLG2,OSMVT . SET MVT FLAG 81000000 RES002 EQU * 82000000 * 83000000 AGO .MEND 86000000 .DIAG5 ANOP 86030000 * FIND UCB ADDRESS GIVEN CUU ADDRESS USING UCB LOOKUP TABLE 86060000 * 86090000 LA R9,UCBBUF . SET UP PARAMETER TABLE 86120000 STM R2,R12,SAVE1 . 86150000 L R3,16 . GET CVT ADDRESS 86180000 L R10,36(R3) . GET CHANNEL & CONTROL UNIT TABLE 86210000 LH R6,2(R9) . GET CUU ADDRESS IN WORK REG 86240000 LR R8,R6 . & ANOTHER WORK REG 86270000 SRDL R6,8 . ISOLATE CHANNEL ADR IN R6 86300000 SRL R7,28 . ISOLATE CONTROL UNIT ADR IN R7 86330000 SLL R7,1 . & DOUBLE IT 86360000 IC R6,0(R10,R6) . GET START OF TBL FOR CHANNEL ADR 86390000 AR R6,R7 . INCREMENT BY CONTROL UNIT DISP 86420000 LH R6,0(R10,R6) . GET TABLE START FOR CONT UNIT ADR 86450000 N R8,DEVMSK . ISOLATE DEVICE ADR IN R8 86480000 AR R6,R6 . DOUBLE ABLVE DISPLACEMENT 86510000 AR R8,R8 . DOUBLE DEVICE ADDRESS 86540000 AR R8,R6 . ADD FOR DISPLACE IN CONT UNIT TBL 86570000 L R10,40(R3) . GET START OF UCB TABLE 86600000 LH R7,0(R10,R8) . GET UCB ADDRESS 86630000 N R7,FWDMSK 86660000 LR R0,R7 . PUT UCB ADDRESS IN PARAMETER REG 86690000 L R1,16(R7) . GET DEVICE DESCRIPTORS 86720000 LM R2,R12,SAVE1 . RESTORE REGISTERS 86750000 AGO .MEND 86780000 .MEND ANOP 87000000 AIF ('&MCT' EQ 'YES').MCT 87010000 MEXIT 87020000 .MCT ANOP 87030000 B IMCTEND . BRANCH AROUND THE MCT. 87040000 .MCTA ANOP 87050000 AIF ('&MCT' EQ 'YES').A 87060000 MEXIT 87070000 .A ANOP 87080000 DEBFREE EQU X'14' . FUNCTION CODE FOR FREE DEB 87090000 GETDEB EQU X'44' 87100000 MOVEDEB EQU X'48' 87110000 * 87120000 * MODULE CONTROL TABLE 87130000 * 87140000 DS 0F . TABLE ALIGNMENT. 87150000 IMCT DC CL4'1MCT' . TABLE IDENTITY. 87160000 .B ANOP 87170000 DC XL4'00' . NEXT MCT ADDRESS. 87180000 DC XL2'FFFF' . INDICATORS. 87190000 DC CL2'QW' . MODULE ID. 87200000 AIF (T'&LENGTH EQ 'O').C 87210000 DC AL2(&LENGTH) . MODULE LENGTH. 87220000 AGO .H 87230000 .C ANOP 87240000 &A SETC '&SYSECT' 87250000 AIF (T'&START EQ 'O').D 87260000 &A SETC '&START' 87270000 .D ANOP 87280000 &B SETC 'IMCTEND' 87290000 AIF ('&X' EQ '1').DA 87300000 &B SETC '0' 87310000 .DA ANOP 87320000 AIF (T'&END EQ 'O').E 87330000 &B SETC '&END' 87340000 .E ANOP 87350000 DC AL2(&B.-&A) MODULE LENGTH. 87360000 .H ANOP 87370000 PATCH DC XL114'00' . PROGRAM MAINTENANCE AREA. 87380000 AIF (T'&ENTRY NE 'O').J 87390000 DC A(&SYSECT) . ENTRY POINT ADDRESS. 87400000 AGO .K 87410000 .J ANOP 87420000 DC A(&ENTRY(1)) . ENTRY POINT ADDRESS. 87430000 AIF (T'&ENTRY(2) EQ 'O').K 87440000 DC A(&ENTRY(2)) . SECOND ENTRY POINT ADDRESS. 87450000 .K ANOP 87460000 DC A(IMCT) . MCT ADDRESS. 87470000 DC XL2'00' . 87480000 DC CL2'QW' . MODULE ID. 87490000 DIAGPL0 DC A(0) . 87500000 DIAGPL4 DC A(0) . 87510000 DIAGPL8 DC A(0) . 87520000 IMCTEND EQU * 87530000 MEND 88000000 ./ ADD SSI=21280194,NAME=DMABCOND,SOURCE=0 MACRO 00100021 &NAME DMABCOND &CODE,&MODID,&SVC=,&DCB=,&RETURN=,&RETCODE=, X00200021 &RES=YES,®SAVE= 00300021 .* 00400021 .* THIS MACRO IS CALLED ONLY BY OPEN/CLOSE/EOV TRANSIENT SVC MODULES 00500021 .* AND A FEW PROBLEM PROGRAM STATE ACCESS METHOD MODULES. 00600021 .* IT IS USED IN PLACE OF AN ABEND MACRO CALL IN ORDER TO XCTL TO AN 00700021 .* OPEN/CLOSE/EOV PROBLEM DETERMINATION MODULE, WHICH WILL ISSUE 00800021 .* A WRITE-TO-PROGRAMMER AND MAY POSSIBLY RECOVER FROM THE ERROR 00900021 .* OR ELSE THEN ISSUE THE ABEND. 01000021 .* 01100021 AIF ('&CODE' EQ '').E1 IF ERROR CODE MISSING 01200021 AIF ('&DCB' EQ '').GEN3 IF NO DCB ADDR 01300021 AIF ('&DCB'(1,1) EQ '(').GEN4 IF DCB ADDR IN REGISTER 01400021 .GEN3 ANOP 01500021 &NAME IHBINNRA &DCB,&CODE LOAD REGS 1 AND 0 01600021 AGO .GEN0 01700021 .GEN4 ANOP FORCE LA INSTEAD OF LR 1,DCB 01800021 &NAME IHBINNRA 0&DCB,&CODE LOAD REGS 1 AND 0 01900021 .GEN0 AIF ('&SVC' EQ 'YES').GENSVC 02000021 MVC DXCALLID,6(RWTG) SAVE ID OF CALLING MODULE 02100021 AIF ('&RETURN' EQ '').CHKWTG 02150021 AIF ('&RETURN' EQ 'NONE').CHKWTG 02160021 AIF ('&RETURN'(1,1) EQ '(').REGRET 02170021 MVC DXRETMOD,&RETURN SAVE ID & TTR OF RETURN MODULE 02180021 AGO .CHKWTG 02190021 .REGRET MVC DXRETMOD,0&RETURN SAVE ID & TTR OF RETURN MODULE 02192021 .* 02194021 .CHKWTG AIF ('&MODID' EQ '').GEN2 02200021 AIF ('&MODID(1)' EQ '(').GEN1 02300021 MVC 0(5,RWTGC),&MODID MOVE ID & TTR INTO WTG TABLE 02400021 AGO .GEN2 02500021 .GEN1 MVC 0(5,RWTGC),0&MODID MOVE ID & TTR INTO WTG TABLE 02600021 .* 02700021 .* 03400021 .GEN2 AIF ('&RES' EQ 'NO').SKPRES 03500021 IECRES XCTL,,&RETCODE BR TO RESIDENT ROUTINE TO XCTL 03600021 MEXIT 03700021 .SKPRES AIF ('®SAVE' NE 'YES').MEXIT 03800021 STM 9,14,DXREG9 SAVE REGISTERS 9-14 03900021 .MEXIT MEXIT 04000021 .* 04100021 .GENSVC LNR 1,1 INDICATE ABEND CONDITION 04200021 SVC 55 ISSUE EOV SVC 04300021 MEXIT 04400021 .* 04500021 .E1 MNOTE 8,'NO CODE SPECIFIED' 04600021 MEND 04700021 ./ ADD SSI=42121304,NAME=DSCAN,SOURCE=0 MACRO 01000001 &LABEL DSCAN &KEY=,&ALT=,&SUCC=,&ROUT=,&BLANKS=,&MAXLEN=,&TYPE=, X02000001 &MINLEN=,&IO=YES,&COMMA=YES 03000001 LCLB &SW1,&SW2,&SW3,&SW4,&SW5,&SW6 04000021 AIF ('&ALT' EQ '').ALTOUT 05000001 &LABEL DC A(&ALT) ADDRESS OF ALTERNATE 06000001 AGO .CONT1 07000001 .ALTOUT ANOP 08000001 &LABEL DC A(0) INDICATE NO ALTERNATE 09000001 .CONT1 AIF ('&SUCC' EQ '').SUCCOUT 10000001 DC A(&SUCC) ADDRESS OF SUCCESSOR 11000001 AGO .CONT2 12000001 .SUCCOUT ANOP 13000001 DC A(0) INDICATE NO SUCCESSOR 14000001 .CONT2 AIF ('&ROUT' EQ '').ROUTOUT 15000001 DC A(&ROUT) ADDR OF EXIT ROUTINE 16000001 AGO .CONT5 17000001 .ROUTOUT ANOP 18000001 DC A(0) INDICATE NO EXIT ROUTINE 19000001 .CONT5 ANOP 20000001 AIF ('&TYPE' NE 'A').CONT6 21000001 &SW1 SETB 1 22000001 AGO .CONT75 23000001 .CONT6 AIF ('&TYPE' NE 'N').CONT7 24000001 &SW2 SETB 1 25000001 AGO .CONT75 26000001 .CONT7 ANOP 27000021 AIF ('&TYPE' NE 'H').CONT72 27050021 &SW6 SETB 1 27100021 AGO .CONT75 27150021 .CONT72 ANOP 27200021 AIF ('&KEY' NE '').CONT75 27250021 &SW1 SETB 1 28000001 &SW2 SETB 1 29000001 .CONT75 AIF ('&BLANKS' NE 'ON').CONT8 30000001 &SW3 SETB 1 31000001 .CONT8 AIF ('&IO' NE 'YES').CONT85 32000001 &SW4 SETB 1 33000001 .CONT85 AIF ('&COMMA' NE 'YES').CONT11 34000001 &SW5 SETB 1 35000001 .CONT11 ANOP 36000001 DC B'&SW1.&SW2.&SW3.&SW4.&SW5.&SW6.00' TYPE SWITCHES 37000021 AIF ('&MAXLEN' EQ '').NOLN 38000001 DC AL1(&MAXLEN) MAXIMUM ARGUMENT LENGTH 39000001 AGO .CONT9 40000001 .NOLN ANOP 41000001 DC AL1(255) DEFAULT MAX ARG LENGTH 42000001 .CONT9 AIF ('&MINLEN' EQ '').NOMIN 43000001 DC AL1(&MINLEN) MINIMUM ARGUMENT LENGTH 44000001 AGO .CONT10 45000001 .NOMIN ANOP 46000001 DC AL1(01) DEFAULT MIN ARG LENGTH 47000001 .CONT10 AIF ('&KEY' NE '').CONT4 48000001 DC H'0' PARM INDICATOR 49000001 MEXIT 50000001 .CONT4 DC AL1(IHX&SYSNDX-*-1) LENGTH OF KEY 51000001 DC C&KEY 52000001 IHX&SYSNDX EQU * 53000001 MEND 54000001 ./ ADD SSI=01012936,SOURCE=1,NAME=DSOCB DCL /* O99*/01000019 /* DIRECT SYSOUT CONTROL BLOCK (DSOCB) O99*/02000019 /* O99*/03000019 1 DSOCB BDY(WORD) BASED(DSOCBPTR), /* O99*/04000019 2 DSOCSCB PTR(31), /* MFT - ADR OF CSCB O99 05000019 CREATED AT 'START' O99 06000019 COMMAND TIME. O99*/07000019 4 DSOECBPT PTR(31), /* MVT-ADR PTR TO O99 08000019 NEXT ECB. O99*/09000019 6 DSOECB CHAR(4), /* MVT - ECB FOR PEND- O99 10000019 ING STOP/MODIFY. O99*/11000019 8 DSOWAIT BIT(1), /* ECB WAIT BIT. O99*/12000019 8 DSOPOST BIT(1), /* ECB POST BIT. O99*/13000019 8 DSOECBCD BIT(30), /* COND CODES, O99 14000019 ETC. O99*/15000019 2 DSONXT PTR(31), /* PTR TO NEXT DSOCB. O99*/16000019 2 DSOID CHAR(1), /* ID OF HEX'FD'. O99*/17000019 2 DSOSCLS CHAR(1), /* SYSOUT CLASS O99 18000019 ASSIGNED TO THIS O99 19000019 DEVICE. O99*/20000019 2 DSOKEY CHAR(1), /* PROTECT KEY OF O99 21000019 PARTITION/INITIATOR O99 22000019 USING THIS DSOCB. O99 23000019 NON-ZERO ENTRY O99 24000019 INDICATES THE DSOCB O99 25000019 HAS BEEN SELECTED O99 26000019 FOR JOB. O99*/27000019 2 * CHAR(1), /* RESERVED O99*/28000019 2 DSOIND1 BIT(8), /* INDICATOR BYTE 1. O99*/29000019 4 DSOTAPE BIT(1), /* TAPE OUTPUT DEVICE O99*/30000019 4 DSOPRINT BIT(1), /* PRINTER OUTPUT DEVICE. O99*/31000019 4 DSOPUNCH BIT(1), /* PUNCH OUTPUT DEVICE. O99*/32000019 /* N O T E - BIT 0 AND 1 OR 2 O99 33000019 MAY BE ON TO DENOTE PRINTER O99 34000019 OR PUNCH DESTINE VIA TAPE. O99*/35000019 4 DSOCR BIT(1), /* THIS DSOCB NOT O99 36000019 AVAILABLE FOR THIS O99 37000019 STEP (CONDITIONED O99 38000019 BY C/R). O99*/39000019 4 DSOSTEP BIT(1), /* DSOCB SELECTED FOR O99 40000019 PRESENT STEP. O99*/41000019 4 DSOJSEP BIT(1), /* JOB SEPARATORS HAVE O99 42000019 BEEN WRITTEN. O99*/43000019 4 DSOMSGCL BIT(1), /* 'DSOSCLS' ALSO EQUALS O99 44000019 THE JOBS MESSAGE CLASS. O99*/45000019 4 DSONOOP BIT(1), /* THIS DSOCB NO LONGER O99 46000019 AVAILABLE FOR O99 47000019 SELECTION. O99*/48000019 2 DSOIND2 BIT(8), /* INDICATOR BYTE 2. O99*/49000019 4 DSOISTOP BIT(1), /* INTERNAL STOP ISSUED DUEO99 49500019 TO SCHEDULER ABEND O99*/50000019 4 DSOSM BIT(1), /* STOP/MODIFY PENDING, O99 50500019 POST ECB IN DSOCB (MVT) O99*/51000019 4 * BIT(6), /* RESERVED BITS O99*/51500019 2 DSOUCB PTR(15), /* ADR OF ALLOCATED O99 52000019 UCB FOR THIS DSOCB. O99*/53000019 2 DSOTIOT CHAR(4), /* MFT - FIELDS FROM DSO O99 54000019 TIOT - TIOESTTA(1), O99 55000019 TIOERLOC(2) AND TIOESTTB(1)O99*/56000019 4 DSOTIOTP PTR(31), /* MVT - ADDR OF TIOT 57000019 IN SQS. O99*/58000019 2 DSOJFCB CHAR(4), /* TTR OF THIS DEVICES 59000019 JFCB ON THE JOB O99 60000019 QUEUE (XXX0). O99*/61000019 2 DSOJCLS CHAR(8), /* JOB CLASSES THIS O99 62000019 DSOCB CAN BE USED O99 63000019 IN. JOB CLASSES O99 64000019 HAVE BEEN CONVERTED O99 65000019 TO SYSTEM JOB CLASS O99 66000019 IDENTIFIERS (QMGR). O99*/67000019 2 DSOSEP CHAR(8), /* JOB SEPARATOR MODULE O99 68000019 NAME. IF NO ENTRY O99 69000019 BIT-5 IN DSOIND1 O99 70000019 IS TO REMAIN ON. O99*/71000019 2 * CHAR(8), /* RESERVED AREA. O99*/72000019 2 DSOCBEND CHAR(1); /* THIS FIELD IS NOT PART OF 73000019 THE DSOCB. IT IS ONLY USED 74000019 IN OBTAINING THE LENGTH OF 75000019 THE DSOCB. */ 76000019 ./ ADD SSI=01030799,SOURCE=1,NAME=DUMPMAC MACRO 00200018 &NAME DUMPMAC &SYS=PCP 00400018 .*516000,544000 M3240 00410019 TITLE 'IGC0801C - WRITE DUMP SUBROUTINE' 00600018 *********************************************************************** 00620018 * MACRO NAME: DUMPMAC * 00640018 * * 00660018 * FUNCTION: 1. DETERMINE DEVICE TO BE WRITTEN UPON. * 00680018 * 2. FOR DIRECT ACCESS, INSURE DATA SET EMPTY. * 00700018 * 3. ATTEMPT WRITING OF CORE IMAGE DUMP. * 00720018 * 4. OUTPUT STATUS MESSAGE TO CONSOLE. * 00740018 * * 00760018 * APPLICABILITY: ALL VERSIONS OF OS/360 ASSEMBLED WITHIN THE FOLLOW- * 00780018 * ING MODULES: * 00800018 * * 00820018 * 1. IEAATM08 - PCP DAR * 00840018 * 2. IEADTM22 - MFT DAR I250 00860019 * 3. IEAQTM08 - MVT/M65MP DAR * 00880018 * * 00900018 * ATTRIBUTES: ASSUMES THOSE OF CALLING ROUTINE. * 00920018 * * 00940018 * ENTRY POINT: ASSIGNED BY CALLER AS: * 00960018 * * 00980018 * NAME DUMPMAC SYS=XXX * 01000018 * * 01020018 * KEYWORD PARAMETER VALUES: * 01040018 * 1. MVT - FOR MVT AND M65MP SYSTEMS 01060018 * 2. MFT - FOR MFT SYSTEMS 01080018 * 3. PCP, BLANK OR OTHER - FOR PCP SYSTEMS * 01100018 * 01120018 * ENTRY IS BY BALR, BAL OR B WITH REG 14 THE RETURN * 01140018 * REG. * 01160018 * * 01180018 * EXITS: NORMAL - BRANCH ON REG 14. * 01200018 * ABNORMAL - NONE * 01220018 * * 01240018 * INPUT : * 01260018 * 01280018 * SUCCESSFUL UTILIZATION OF THIS MACRO/SUBROUTINE DEPENDS UPON THE 01600018 * PROPER INITIALIZATION OF THE FOLLOWING REGISTERS - 01800018 * 02000018 * 1. REG 2 - CVT ADDRESS - USING STMNT TO CVTSECT REQ'D. 02200018 * 2. REG 9 - SVRB ADDRESS E.G. DAR'S SVRB ADDRESS 02400018 * 3. REG 12 - CURRENT TCB ADDRESS - USING STMNT TO TCBSECT REQ'D 02600018 * 4. REG 14 - RETURN ADDRESS 02800018 * 03000018 * REGISTERS DESTROYED BY THIS ROUTINE ( NOTE CALLERS REG'S ARE NOT 03200018 * SAVED). 03400018 * 03600018 * 1. REG 4 - WORK REG 03800018 * 2. REG 7 & 8 - INTERNAL LINK REG'S. 04000018 * 4. REG 11 - LOADED WITH UCB ADDR OF DEVICE HOUSING SYS1.DUMP 04200018 * 3. REG 10 - LOADED WITH I/O CONTROL BLOCK ADDR FOR WRITING 04400018 * OF THE CORE IMAGE DUMP 04480018 * 4. REG 13 - USED AS A SECOND BASE REG. IF SYS1.DUMP IS ON TAPE. 04560018 * 5. REG 11 - USED AS AN INTERNAL LINK REG IF SYS1.DUMP ON TAPE 04640018 * REMAINING REGISTERS NOT ALTERED. 04720018 * 04800018 * CAUTION SHOULD BE TAKEN IN THE USE OF A BASE REG - INSURE IT IS NOT 05000018 * ONE OF THOSE REGISTERS DESTROYED BY THIS MACRO/SUBROUTINE 05200018 * * 05201018 * OUTPUT: STATUS MESSAGES WRITTEN TO THE CONSOLE ARE AS FOLLOWS* 05202018 * * 05203018 * IEA022I JOBNAME STEPNAME CORE IMAGE FAILED -1 * 05204018 * -2 * 05205018 * -3 * 05206018 * * 05207018 * 1. IEA022I - 1: SYS1.DUMP DATA SET FULL * 05208018 * * 05209018 * 2. IEA022I - 2: AN I/O ERROR OCCURRED DURING DATA SET * 05210018 * INITIALIZATION (DIRECT ACCESS ONLY) * 05211018 * * 05212018 * 3. IEA022I - 3: AN I/O ERROR OCCURRED DURING THE ACTUAL * 05213018 * WRITING OF THE CORE IMAGE DUMP. * 05214018 * * 05215018 * * 05216018 * IEA023I JOBNAME STEPNAME CORE IMAGE COMPLETE -1 * 05217018 * * 05218018 * * 05219018 * EXTERNAL REFERENCES: * 05220018 * * 05221018 * 1. CVT * 05222018 * 2. UCB * 05223018 * 3. TCB * 05224018 * 4. SVRB * 05225018 * * 05226018 * SVC'S USED: * 05227018 * 1. WTO - SVC 35 * 05228018 * 2. EXCP - SVC 0 * 05229018 * 3. WAIT - SVC 1 * 05230018 * * 05231018 * EXTERNAL DEPENDENCIES: * 05232018 * * 05233018 * DURING IPL/NIP PROCESSING, NIP OBTAINS SPACE FOR AND * 05234018 * PARTIALLY INITIALZES A SET OF CONTROL BLOCKS USED BY * 05235018 * THIS SUBROUTINE TO WRITE THE CORE IMAGE DUMP. THESE * 05236018 * CONTROL BLOCKS ARE POINTED TO BY THE CVTDAR FIELD. * 05237018 * IF NO PROVISIONS FOR SYS1.DUMP WERE MADE DURING IPL, * 05238018 * NIP SETS THE CVTDAR FIELD TO ZERO. A DIAGRAM OF THE * 05239018 * CONTROL BLOCKS FOLLOWS: * 05240018 * * 05241018 EJECT 05242018 * 05243018 * MAP OF I/O CONTROL BLOCKS SET UP BY NIP FOR DAR * 05244018 * 05245018 * CVT * 05246018 * ******************** * 05247018 * 0 * * * 05248018 * * * * 05249018 * ******************** * 05250018 * 72 * * * 05251018 * * CVTDAR - ADDR OF * * 05252018 * * DAR'S CONTROL ********** * 05253018 * * BLOCKS * * * 05254018 * * * * * 05255018 * ******************** * * 05256018 * * * * * 05257018 * * * * * 05258018 * * * * * 05259018 * * * * * 05260018 * ******************** * * 05261018 * * * 05262018 * * * 05263018 * * * 05264018 * * * 05265018 * *********************************************** * 05266018 * * * 05267018 * * * 05268018 * * * 05269018 * * * 05270018 * ***** * 05271018 * *** * 05272018 * * * 05273018 * * 05274018 * DUMMY 0*********************** * 05275018 * DCB * DEB ADDRESS * * 05276018 * ********************************************** * 05277018 * DEB 4* * * 05278018 * * * * 05279018 * * * * 05280018 * * * * 05281018 * * * * 05282018 * ********************************************** * 05283018 * ECB 52* * * 05284018 * ********************************************** * 05285018 * IOB 54* * * 05286018 * * * * 05287018 * * * * 05288018 * * * * 05289018 * * * * 05290018 * ********************************************** * 05291018 EJECT 05292018 * ********************************************** * 05293018 * 96* CCW 1 * CCW 2 * * 05294018 * ********************************************** * 05295018 * 112* CCW 3 * CCW 4 * * 05296018 * ********************************************** * 05297018 * 128* CCW 5 * CCW 6 * * 05298018 * ********************************************** * 05299018 * 114* CCW 7 * CCW 8 * * 05300018 * ********************************************** * 05301018 * 160* FAILING TCB ADDR * SPARE SPACE * * 05302018 * ********************************************** * 05303018 * * 05304018 * TOTAL LENGTH = 168 BYTES * 05305018 * * 05306018 * MOTE: MACRO DARMAC, EXPANDS TO PROVIDE A MAPPING DSECT OF THE ABOVE* 05307018 * CONTROL BLOCK COMPLEX. DARMAC IS CALLED BY DUMPMAC FOR JUST * 05308018 * THAT PURPOSE. * 05309018 EJECT 05310018 * * 05311018 * OPERATION: * 05312018 * THIS SUBROUTINE IS BASICALLY AN I/O ROUTINE, CAPABLE * 05313018 * OF WRITING A CORE IMAGE DUMP TO A PRE-ALLOCAGED * 05314018 * DATA SET (SYS1.DUMP) WHICH MAY RESIDE ON TAPE OR A * 05315018 * DIRECT ADDESS DEVICE. * 05316018 * * 05317018 * INITIALLY, THE UCB ADDRESS OF THE DEVICE UPON WHICH * 05318018 * SYS1.DUMP RESIDES IS OBTAINED FROM DAR'S IOB (PROVID-* 05319018 * ED BY NIP). IT CAN THEN BE DETERMINED WEATHER THE * 05320018 * DATA SET IS UPON TAPE OR DIRECT ACCESS. * 05321018 * * 05322018 * DIRECT ACCESS: * 05323018 * * 05324018 * A CHANNEL PROGRAM IS SET UP TO READ THE FIRST RECORD * 05325018 * ON THE DATA SET. IF THE DATA SET IS EMPTY, AN END OF * 05326018 * FILE RECORD WILL BE READ CAUSING A UNIT CHECK * 05327018 * CONDITION. THE ABSENCE OF A UNIT CHECK MEANS THE DATA* 05328018 * SET IS FULL AND MESSAGE IEA022I-1 IS OUTPUTTED TO * 05329018 * THE CONSOLE. NO FURTHER I/O ATTEMPT IS MADE. * 05330018 * * 05331018 * IF THE DATA SET IS EMPTY THE EOF RECORD NEEDS TO BE * 05332018 * OVERLAID WITH A FORMAT RECORD. A CHANNEL PROGRAM IS * 05333018 * INITIALIZED TO PERFORM A WRITE COUNT KEY DATA TO * 05334018 * 'REFORMAT' THE FIRST RECORD. UPON COMPLETION, SHOULD * 05335018 * AN I/O ERROR OCCUR, MESSAGE IEA022I-2 IS WRITTEN AND * 05336018 * I/O ACTIVITY ENDS. * 05337018 * * 05338018 * EXCP AND WAIT ARE USED TO EXECUTE THE ABOVE TWO * 05339018 * CHANNEL PROGRAMS. * 05340018 * * 05341018 * THE ACTUAL WRITING OF THE CORE IMAGE DUMP IS NOW * 05342018 * ATTEMPTED USING TWO CHANNEL PROGRAMS AND A PCI * 05343018 * APPENDAGE. SIMILIARLY A CHANNEL END APPENDAGE * 05344018 * AND AN ABNORMAL END APPENDAGE ARE PROVIDED TO HANDLE * 05345018 * 1. LAST WRITE * 05346018 * 2. TIMING DELAYS * 05347018 * 3. END OF CYLINDER CONDITIONS * 05348018 * * 05349018 * EXCP AND WAIT ARE USED TO EXECUTE THE CHANNEL PGM. * 05350018 * * 05351018 * UPON COMPLETION, THE ECB IS EXAMINED TO DETERMINE * 05352018 * IF A SUCCESS OR FAILURE MESSAGE IS TO BE ISSUED. * 05353018 * * 05354018 * TAPE: * 05355018 * * 05356018 * WRITING TO TAPE IS SIMILIAR TO THAT ALREADY DESCRIBED* 05357018 * WITH THE EXCEPTION THAT ONLY ONE CCW IS USED AND NO * 05358018 * APPENDAGES ARE PROVIDED. EACH RECORD IS WRITTEN * 05359018 * SEQUENTIALLY, CHECKING THE ECB AFTER EACH WRITE. * 05360018 * DEPENDING UPON THE COMPLETION CODE IN THE ECB, A * 05361018 * SUCCESS OR FAILURE MESSAGE IS WRITTEN TO THE CONSOLE.* 05362018 * * 05363018 * TERMINATION: * 05364018 * * 05365018 * AFTER OUTPUTTING THE FINAL STATUS MESSAGE, THE CALLER* 05366018 * IS RETURNED TO VIA BRANCH REG 14. * 05367018 *********************************************************************** 05368018 EJECT 05400018 * REGISTER EQUATES 05600018 CVTREG EQU 2 05800018 BASEREG EQU 3 06000018 WORK EQU 4 06200018 XRET2 EQU 7 06400018 XRET EQU 8 06600018 SVRBREG EQU 9 06800018 DARREG EQU 10 07000018 UCBREG EQU 11 07200018 LNKREG EQU 11 07400018 TCBREG EQU 12 07600018 BASE2 EQU 13 07800018 RETREG EQU 14 08000018 XREG EQU 15 08200018 EJECT 08400018 * FLAG MASKS 08600018 RWUNL EQU X'0F' REWIND & UNLOAD OP CODE (TAPE) 08800018 SUPPL EQU X'20' SUPPRESS WRONG LENGTH MASK 09000018 MISCMSK EQU X'3F' CHAN ERROR, ETC. 09200018 PCIFLAG EQU X'80' CCW USAGE INDICATOR 09400018 WRITECOD EQU X'05' WRITE DATA TO D.A. OP CODE 09600018 MASK1 EQU X'68' . CCW FLAGS - C.C.,S.L.I.,P.C.I. 09800018 MASK2 EQU X'42' IOB FLAG MASK 10000018 MASK3 EQU X'70' CCW FLAGS 10200018 SUCCESS EQU X'7F' ECB POST CODE FOR GOOD I/O 10400018 XZERO EQU X'00' 10600018 DARREC EQU X'80' DAR RECURSION FLAG 10800018 UCBREADY EQU X'40' UCB READY FLAG 11000018 DEVMSKT EQU X'80' TAPE DEVICE FLAG 11200018 UNITCK EQU X'02' I/O DEVICE ERROR FLAG 11400018 SRCHIDEQ EQU X'31' OP CODE FOR SEARCH ID EQUAL CCW 11600018 TIC EQU X'08' OP CODE FOR TRANS. IN CHAN. CCW 11800018 NOP EQU X'03' OP CODE FOR NOP CCW 12000018 UNITPXP EQU X'01' UNIT EXCEPTION FLAG IN CSW 12200018 CON2 EQU X'20' SUPPRESS WRONG LENGTH IN CCW 12400018 WCKD EQU X'1D' WRITE COUNT KEY DATA OP CODE 12600018 DATACHN EQU X'60' CCW CHAIN & SLI FLAGS 12800018 READ EQU X'06' READ DATA OP CODE 13000018 FOX1 EQU C'1' 13200018 FOX2 EQU C'2' . NO SYS1.DUMP WAS ALLOCATED 13400018 FOX3 EQU C'3' 13600018 FOX4 EQU C'4' 13800018 FOX5 EQU C'5' 14000018 FOX6 EQU C'6' 14200018 FOX7 EQU C'7' 14400018 WAIT EQU 1 14600018 R1 EQU X'01' 14800018 RUNMASK EQU X'0F' 15000018 TAPEMASK EQU X'F3' 15200018 WTM EQU X'1F' 15400018 IOFLAG EQU X'42' 15600018 ENDCYL EQU X'20' 15800018 NOPCICC EQU X'B7' . FOR LAST WRITE 16000018 MTBIT EQU X'80' 16200018 SYSERTNS EQU X'0C' 16400018 ZERO EQU 0 16600018 INDEX4 EQU 4 16800018 COUNT EQU 8 17000018 ESANDX EQU 96 17200018 L4 EQU 4 17400018 L5 EQU 5 17600018 L2 EQU 2 17800018 ESAFLG EQU 104 18000018 ESAHICNT EQU 100 18200018 L3 EQU 3 18400018 PARMREG EQU 1 18600018 L9 EQU 9 18800018 C113 EQU 113 18820018 C124 EQU 124 CONSTANT OF 124 18840018 C128 EQU 128 CONSTANT OF 128 18860018 C132 EQU 132 CONSTANT OF 132 18880018 C136 EQU 136 CONSTANT OF 136 18900018 LEN8 EQU 8 18920018 ESAADR EQU 98 19000018 K1 EQU 1 19200018 K32 EQU 32 19400018 ESACNT EQU 97 19600018 COUNT2 EQU 16 19800018 WTO EQU 35 20000018 MSGLOC EQU 88 20200018 DARPTR EQU 72 20400018 EJECT 20600018 * CONTROL BLOCK DISPLACEMENTS 20800018 UCBFL1 EQU 6 21000018 UCBTYP EQU 16 21200018 DEVTYPE EQU 18 21300018 EJECT 21400018 * 21600018 * WRITE DUMP SUBROUTINE 21800018 * 22000018 &NAME EQU * 22200018 L DARREG,CVTDAR ADDRESS I/O CONTROL BLOCK 22400018 * COMPLEX SET UP BY NIP 22600018 USING DARSECT,DARREG BASE TO ADDRESS C.B. COMPLEX 22800018 L UCBREG,DARUCBAD . GET UCB ADDR OF SYS1.DUMP DEVICE 22900018 BAL XRET2,IOBFIX . REFRESH IOB FIELDS 23000018 * LAST 5 WORDS IN SVRB TO BE USED AS I/O APP. VECTOR TABLE 23020018 LA WORK,C124(SVRBREG) . GET APP. TAB. ADDR. 23040018 ST WORK,RBEXSAVE . TEMP STORAGE 23060018 MVC DARIOAPT(L3),RBEXSAVE+K1 TO MOVE INTO CONT. BLK. 23080018 LA WORK,CVTBRET GET ADDR OF BR14 INSTR IN CVT 23100018 ST WORK,C124(SVRBREG) . DUMMY END OF EXTENT APP. 23120018 ST WORK,C128(SVRBREG) . DUMMY SIO APPENDAGE 23140018 MVC C136(LEN8,SVRBREG),C124(SVRBREG) 23160018 * DUMMY CE AND ABNORMAL END APP. 23180018 AIF (('&SYS' EQ 'MVT') OR ('&SYS' EQ 'MFT')).DO1 23182018 AGO .SKIP4 23184018 .DO1 ANOP 23186018 L WORK,CVTBTERM . GET ADDR OF ABTERM 23188018 USING TERMSECT,WORK . ADDRESS ABTERM LOCATOR FIELDS 23190018 L WORK,PCI1 . GET ADDR OF PCI APPENDAGE RTN 23192018 DROP WORK 23194018 AGO .SKIP5 23196018 .SKIP4 ANOP 23198018 LA WORK,PCIAPP . GET REAL PCI APP. ADDR 23200018 .SKIP5 ANOP 23210018 ST WORK,C132(SVRBREG) . STORE IN APP. TAB. 23220018 * INITIALIZATION COMPLETE 23240018 ST TCBREG,DARTCBSV . SAVE THE TCB ADDRESS 23260018 TM DEVTYPE(UCBREG),DEVMSKT IS DEVICE TYPE TAPE 23400018 BO DOTAPE . IF TAPE, BRANCH 23600018 * DEVICE IS DIRECT ACCESS - INITIALIZE CONTROL BLOCKS 23800018 EJECT 24000018 * INITIALIZE 1ST SET OF CCW'S FOR READ 24200018 MVI DARCCW3,READ . SET OP CODE TO READ 24400018 MVC CCW3FLG(L4),CON1 . SET FLAGS FOR READ 24600018 MVI DARCCW4,NOP . SET OP CODE FOR NOP 24800018 MVI CCW4FLG,CON2 . ADJUST FLAGS 25000018 MVI CCW4CNT,READ . SET COUNT TO POS NO. 25200018 BAL XRET,DOEXCP . GO READ DATA 25400018 TM CSWSTAT1,UNITPXP . DID UNIT EXCEPTION RESULT FROM 25600018 * READ. (IF DATA SET IS AVAILABLE, 25800018 * THE FIRST RECORD WILL BE AN EOF 26000018 * CAUSING A UNIT EXCEPTION). 26200018 MVI NUMBER,FOX2 . SET MSG NUMBER 26300018 MVI CODENO,FOX1 . SET MSG ID 26400018 BZ DUMP . NO, DATA SET FULL 26600018 EJECT 26800018 * INIT CCW TO REWRITE 1ST FORMAT RECORD 27000018 * SEARCH & TIC REMAIN THE SAME FOR THIS WRITE 27200018 MVC DARVOID1(L5),SEARCHAD . GET CCHHR FOR COUNT FIELD 27400018 MVI RECDNO,XZERO . SEARCH RECORD = R0 27600018 MVI KEY,XZERO . ZERO KEY 27800018 MVC DATALNGH(L2),DARRSIZE . DATA LENGTH = TRACK SIZE 28000018 LA WORK,DARVOID1 . GET WORK AREA ADDR 28200018 ST WORK,DARCCW3 . CCW POINTS TO WORK AREA 28400018 MVI DARCCW3,WCKD . OP CODE FOR WRITE CT,KEY,DATA 28600018 LH WORK,DARRSIZE . GET RECORD SIZE 28800018 LA WORK,COUNT(WORK) . ADD 8 - COUNT FIELD SIZE 29000018 STH WORK,CCW3CNT . SET COUNT 29200018 MVI CCW3FLG,DATACHN . SET FLAGS 29400018 * NOP CCW OK FROM LAST EXCP 29600018 BAL XRET,DOEXCP WRITE COUNT,KEY,DATA 29800018 TM CSWSTAT1,UNITCK . SEE IF UNIT CHECK OCCURED 30000018 MVI CODENO,FOX2 . SET MSG ID 30200018 BO DUMP . GO IF UNIT CHECK 30400018 TM CSWSTAT2,MISCMSK . SEE IF CHANNEL OR ANOTHER ERROR 30600018 BM DUMP . IF SO, GO PRINT MSG. 30800018 LA WORK,CEAPP . GET CHAN. END APP. ADDR. 30900018 ST WORK,C136(SVRBREG) . ADJUST APP. VECTOR TAB. TO 31100018 * POINT TO PROPER CE APP ROUTINE 31200018 AIF (('&SYS' EQ 'PCP') OR ('&SYS' EQ 'MFT')).SKIP10 31240018 ST WORK,C140(SVRBREG) . SET ADDR OF ABNORMAL END APP. 31280018 C140 EQU 140 31320018 .SKIP10 ANOP 31360018 BAL XRET,FIXAREA . GO SET UP TO WRITE CORE 31400018 OI ESAFLG(SVRBREG),PCIFLAG .SET INDICATOR FOR PCI 31600018 * INITIALIZE FIRST SET OF CHAN PGMS TO WRITE DATA 31800018 MVI RECDNO,R1 . SET SEARCH ARGUMENT (R1) 32000018 XC DARCCW3,DARCCW3 . SET DATA ADDR TO LOC 0 32200018 MVI DARCCW3,WRITECOD . SET OP CODE FOR WRITE DATA 32400018 MVI CCW3FLG,MASK1 . SET FLAGS - CC,PCI, SLI 32600018 MVI CCW7FLG,MASK1 . REFRESH FLAGS 32800018 MVC CCW3CNT(L2),DARRSIZE . SET COUNT 33000018 MVC CCW7CNT(L2),DARRSIZE . SET COUNT IN CASE LAST PASS HAD 33200018 * A SHORT RECORD 33400018 LA WORK,DARCCW5 . SET TIC 33600018 ST WORK,DARCCW4 . CCW 33800018 MVI DARCCW4,TIC . SET OP CODE FOR TIC 34000018 MVI CCW4FLG,DATACHN . SET CCW FLAGS 34200018 AIF ('&SYS' EQ 'PCP').SKIPER M3240 34210019 TM TCBDAR,EDAR . Q.SURPRESS ERPS M3240 34220019 BO NODERP . YES-BRANCH M3240 34230019 .SKIPER ANOP M3240 34240019 MVI DARERCTL,XZERO . ALLOW USE OF SYS ERROR RTNS 34400018 NODERP EQU * . M3240 34410019 BAL XRET,DOEXCP . WRITE DATA 34600018 MVI DARERCTL,SYSERTNS . PROHIBIT USE OF SYS ERROR RTNS 34800018 MVC SEARCHAD(L4),DARCYLST . REFRESH START ADDR OF DATA SET 35000018 MVC SEEKAD(L4),DARCYLST . REFRESH IOB SEEK ADDRESS 35200018 MVI DARCCW1,SRCHIDEQ . REFRESH SEARCH CCW (NO M-T) 35400018 CLI DARECB,SUCCESS . SEE IF I/O WAS GOOD 35600018 MVI NUMBER,FOX3 . SET MSG CODE NO 35800018 MVI CODENO,FOX1 . SET MSG ID 36000018 BE GOODDUMP . DUMP WAS WRITTEN CORRECTLY 36200018 DUMPENT1 EQU * 36400018 MVI NUMBER,FOX2 . RESET MESSAGE NO 36600018 EJECT 36800018 DUMPFAIL EQU * 37000018 MVI CODENO,FOX3 . SET MSG ID 37200018 DUMP EQU * 37400018 MVC STATUSG(COUNT),STATUSB . SET MESSAGE TEXT 37600018 GOODDUMP EQU * 37800018 L TCBREG,DARTCBSV . RESTORE TCB ADDR 37880018 DUMPENT2 EQU * 37920018 MVC C88(MSGLEN1,SVRBREG),MSGCON MOVE IN MSG 37960018 C88 EQU 88 38000018 MVC C100(LEN17,SVRBREG),C99(SVRBREG) BLANK OUT 38060018 * JOBNAME/STEPNAME IN MESSAGE 38120018 C109 EQU 109 38140018 C100 EQU 100 38160018 C99 EQU 99 38180018 AIF ('&SYS' EQ 'MVT').SKTIOT M3355 38190019 TM TCBCMP,TCBIND . Q. TCBTIOT VALID M3355 38191019 BO NONAME . NO-BRANCH M3355 38192019 TCBIND EQU X'02' . INDICATIVE DUMP BIT M3355 38193019 .SKTIOT ANOP M3355 38194019 L WORK,TCBTIO GET TIOT ADDR 38200018 LTR WORK,WORK . IS THERE A TIOT FOR THIS TASK 38400018 BZ NONAME NO, BRANCH TO FIX MSG 38600018 MVC C100(LNAMES,SVRBREG),ZERO(WORK) PUT IN JOBNAME/STEP- 38800018 MVC C109(LNAMES,SVRBREG),LEN8(WORK) NAME INTO MSG 39000018 NONAME EQU * 39200018 LA PARMREG,C88(SVRBREG) . SET PTR TO MSG FOR WTO 39400018 AIF ('&SYS' EQ 'MVT').SKIPP 39420018 TM TCBFLGS,STEAL HAS CORE BEEN STOLEN TO PROCESS 39440018 * ABEND 39460018 STEAL EQU X'02' 39480018 BCR 1,RETREG YES, SKIP WTO 39500018 .SKIPP ANOP 39520018 SVC WTO . WRITE MESSAGE TO CONSOLE 39600018 BR14 BR RETREG . RETURN 39800018 MSGCON DC AL2(MSGLEN) OVERALL LENGTH OF MESSAGE 40000018 DC X'8000' 40200018 MSGCODE DC C'IEA021I ' MSG CODE NUMBER 40400018 STATUSB DC C'FAILED ' FAILURE PORTION OF MSG 40500018 STATUSA DC C'BYPASSED' DUMP SUBROUTINE BYPASS 40600018 DC C' CORE IMAGE ' MSG CONSTANT 40700018 STATUSG DC C'COMPLETE ' SUCCESS PART OF MSG 40800018 DC C'-' 40900018 CODENO DC C'1' 41000018 MSGEND EQU * 41100018 DC X'10008000' . MCS - ROUTING CODE, DESCRIPTOR 41120018 * CODE 41140018 MSGEND1 EQU * 41160018 MSGLEN1 EQU MSGEND1-MSGCON 41180018 ONE EQU 1 41200018 C92 EQU 92 41300018 C104 EQU 104 41400018 C103 EQU 103 41500018 LEN17 EQU 17 41600018 LNAMES EQU 8 . LENGTH OF JOB AND STEP NAMES 41700018 MSGLEN EQU MSGEND-MSGCON MESSAGE LENGTH 42400018 NUMBER EQU MSGCODE+5 42600018 EJECT 42800018 DOTAPE DS 0H 43000018 LA WORK,DARCCW3 . GET TAPE CCW ADDR 43200018 ST WORK,DARCCWAD . STORE IN IOB 43400018 MVC DARRSIZE(L2),CCW3CNT . INIT RECORD SIZE FIELD 43600018 BAL XRET,FIXAREA . SET UP COUNTERS 43800018 AIF ('&SYS' EQ 'PCP').SKIPER2 M3240 43810019 TM TCBDAR,EDAR . Q.SURPRESS ERPS M3240 43820019 BO NOTERP . YES-BRANCH M3240 43830019 .SKIPER2 ANOP M3240 43840019 MVI DARERCTL,XZERO . ALLOW USE OF SYS ERR RTNS M3240 43850019 NOTERP EQU * . M3240 43860019 BAL XRET,TAPEEXCP . WRITE CORE 44000018 CLI DARECB,SUCCESS . SEE IF I/O WAS SUCCESSFUL 44200018 BNE RUN . SET UP FAIL MSG M3240 44400019 CLC ESANDX(L4,SVRBREG),ESAHICNT(SVRBREG) SEE IF ALL WRITTEN 44600018 BE DUMPRAN . DONE, GO CLEAN UP M3240 44800019 AIF (('&SYS' EQ 'MVT') OR ('&SYS' EQ 'MFT')).DO2 44810018 AGO .SKIP6 44820018 .DO2 ANOP 44830018 L BASE2,CVTBTERM . GET ADDR OF ABTERM 44840018 USING TERMSECT,BASE2 . ADDRESS ABTERM LOCATOR FIELDS 44850018 L WORK,PCI2 . SET BRANCH REG TO UPDATE RTN 44860018 L BASE2,PCI1 . SET BASE REG FOR UPDATE RTN 44870018 DROP BASE2 44880018 LA BASE2,L2(BASE2) . BUMP PAST 1ST BALR INSTR 44890018 BALR LNKREG,WORK . LINK TO UPDATE RTN 44900018 AGO .SKIP7 44910018 .SKIP6 ANOP 44920018 LA BASE2,PCIAPP2 . SET UP SUBROUTINE BASE REG 45000018 BAL LNKREG,UPDATE . USE SUB RTN TO UPDATE CTR 45200018 .SKIP7 ANOP 45300018 B TAPEEXCP . DO NEXT WRITE - RET REG STILL OK 45400018 RUN EQU * 45600018 MVC CCW3CNT(L2),DARRSIZE . REFRESH COUNT 45800018 XC CCW3ADR(L3),CCW3ADR . REFRESH WRITE ADDR TO ZERO 46000018 LA WORK,TAPECCW . SET IOB TO REWIND/UNLOAD CCW 46200018 ST WORK,DARCCWAD . SET IOB CCW PTR 46400018 MVI TAPECCW,WTM . SET OP CODE FOR WRITE TAPE MARK 46600018 MVI DARTMODE,WTM . SET MODE CODE IN CONT BLOCK 46800018 BAL XRET,TAPEEXCP . WRITE TAPE MARK 47000018 MVI TAPECCW,RUNMASK . SET FOR REWIND/UNLOAD 47200018 MVI DARTMODE,RUNMASK . SET MODE BITS FOR RUN 47400018 BAL XRET,TAPEEXCP . DO REWIND/UNLOAD 47600018 AIF ('&SYS' EQ 'PCP').SKIPER3 M3240 47601019 MVI DARERCTL,SYSERTNS . REFRESH ERR FLAGS M3240 47610019 .SKIPER3 ANOP M3240 47620019 MVI DARTMODE,TAPEMASK . RESET MODE BITS FOR WRITE 47800018 CLI NUMBER,FOX3 . Q. GOOD DUMP M3240 47810019 BE GOODDUMP . YES-WRITE SUCCESS MESSAGE M3240 47820019 B DUMPENT1 . DUMP FAILED M3240 47830019 DUMPRAN MVI NUMBER,FOX3 . SET SUCCESS MSG M3240 48000019 MVI CODENO,FOX1 . SET MSG ID 48200018 B RUN . GO CLEAN UP M3240 48400019 CON1 DC X'70000005' . CCW CONSTANT M3355 48410019 DS 0D 48600018 TAPECCW EQU * 48800018 DC X'0F' . REWIND/UNLOAD COMMAND 49000018 DC AL3(0) . DUMMY DATA ADDR 49200018 DC X'2000' SUPPRESS INCORRECT LENGTH 49400018 DC H'0' 49600018 TITLE 'IGC0801C - COMMON SUBROUTINES' 49800018 DOEXCP EQU * 50000018 LA WORK,DARCCW1 . GET CHAN PGM ADDR 50200018 ST WORK,DARCCWAD . STORE IN IOB 50400018 MVI DARIOBF1,IOFLAG . HOUSEKEEP IO FLAGS 50600018 TAPEEXCP EQU * 50800018 LA PARMREG,DARIOB . GET IOB ADDR FOR EXCP 51000018 MVI DARECB,XZERO . CLEAR ECB 51200018 SVC ZERO . ISSUE EXCP 51400018 LA PARMREG,DARECB . GET ECB ADDR 51800018 LA ZERO,K1(ZERO) . SET COUNT TO ONE 52000018 SVC WAIT . WAIT FOR I/O TO CPT. 52200018 SSM DISABLE . PREVENT INTERRUPTS 52400018 BR XRET . RETURN TO CALLER 52600018 FIXAREA EQU * 52800018 XC ESANDX(L9,SVRBREG),ESANDX(SVRBREG) . CLEAR WORK AREA 53000018 MVC ESAADR(L2,SVRBREG),DARRSIZE . SET UP FOR SECOND WRITE 53200018 MVC ESAHICNT(L4,SVRBREG),CVTMZ00 . SAVE HI ADDR IN MACHINE 53400018 AIF ('&SYS' NE 'MVT').SKIP1 53410018 CLI CVTDCB,M65MP . IS THIS MP65 53420018 BCR NOTEQ,XRET . NOT MP, RETURN 53430018 OI ESAHICNT+L2(SVRBREG),FOXS IF THIS IS MP65, THE HI 53440018 * ADDR IN THE CVT WILL BE LESS THE 53450018 * SECOND PREFIX AREA. THIS OR WILL 53460018 * CONVERT THE ADDR TO A THE REAL 53470018 * HI MACH ADDR. 53480018 M65MP EQU X'14' . M65MP MODE MASK 53490018 FOXS EQU X'FF' 53495018 NOTEQ EQU 7 53500018 .SKIP1 ANOP 53510018 BR XRET . RETURN TO CALLER 53600018 EJECT 53800018 * CONSTANTS 54000018 DISABLE EQU CON1+1 56800018 TITLE 'IGC0801C - CHAN. END / ABNORMAL END APPENDAGE ROUTINE' 57100018 DROP BASEREG 57400018 CEAPP DS 0H 57600018 CECVT EQU 11 57800018 CESVRB EQU 12 58000018 CEBASE EQU 13 58200018 CEDAR EQU DARREG 58400018 BALR CEBASE,ZERO . SET UP ADDRESSABILITY 58600018 USING *,CEBASE . FOR SUBROUTINE 58800018 L CECVT,CVTPTR . GET CVT ADDR 59000018 L CEDAR,DARPTR(CECVT) . GET CONTROL BLOCK ADDR 59200018 L CESVRB,DARTCBSV . GET THE ACTIVE TCB ADDR 59400018 L CESVRB,ZERO(CESVRB) . GET SVRB ADDRESS 59600018 AIF (('&SYS' EQ 'PCP') OR ('&SYS' EQ 'MFT')).SKIP11 59610018 TM DARCSW+L3,UNITCK . HAS UNIT CHECK OCCURRED 59620018 BZ TSTCORE . NO, TREAT AS CHAN. END 59630018 TM DARIOBS2,ENDCYL . HAS END OF CYLINDER BEEN REACHED 59640018 BCR NOENDCYL,RETREG . NOT END OF CYL - NO RESTART 59650018 NOENDCYL EQU 8 59660018 NI DARIOBF1,NOEXCP . TURN OFF EXCEPTION FLAG 59670018 NOEXCP EQU X'FB' 59680018 L CECVT,DARUCBAD . ADDRESS UCB FOR SYS1.DUMP 59690018 MVC UCBCCHH(L4,CECVT),DARVOID1 UPDATE UCB CCHH FOR RESTART 59700018 UCBCCHH EQU 51 59710018 B IOBCCHH . UPDATE IOB CCHH FOR RESTART. 59720018 .SKIP11 ANOP 59730018 TSTCORE EQU * 59740018 CLC ESANDX(L4,CESVRB),ESAHICNT(CESVRB) SEE IF ALL WRITTEN 59800018 BCR COUNT,RETREG . YES, RETURN TO IOS 60000018 IOBCCHH EQU * 60200018 ST WORK,DARSPARE . SAVE IOS INFO 60400018 LA WORK,DARCCW5 . GET ADDR OF CHAN PGM NO 2 60600018 TM ESAFLG(CESVRB),PCIFLAG . SEE IF FIRST CP IS IN USE 60800018 BZ STORECCW . NO, SET CCW TO POINT TO CCW1 61000018 LA WORK,DARCCW1 . GET ADDR OF CHAN PGM NO 1 61200018 STORECCW EQU * 61400018 ST WORK,DARCCWAD . SET IOB TO APPROPRIATE CP 61600018 NI ZERO(WORK),SUCCESS . PREVENT MULTI TRK SEARCH 61660018 L WORK,DARSPARE . RESTORE IOS INFO 61720018 TM DARIOBS2,ENDCYL . END OF CYLINDER 61820018 BZ GOON . SKIP IOB CCHH UPDATE 62000018 MVC SEEKAD(L4),DARVOID1 . UPDATE IOB CCHH PTR FOR RESTART 62200018 * SYSTEM TO DO SEEK TO NEXT CYL 62400018 GOON EQU * 62440018 LR CECVT,XRET2 . SAVE IOS INFO 62480018 BAL XRET2,IOBFIX . REFRESH IOB FIELDS 62520018 LR XRET2,CECVT . RESTORE IOS INFO 62560018 B COUNT(RETREG) . RETURN FOR RESTART 62600018 IOBFIX EQU * 62800018 MVI DARIOBF1,MASK2 . RESET FLAGS 63000018 XC DARIOBF2(L3),DARIOBF2 . CLEAR FLAGS2 AND SENSE FLAGS 63100018 XC DARIOBF3(COUNT),DARIOBF3 CLEAR FLAG3 AND CSW FIELDS 63200018 XC ERRCT(L2),ERRCT . ZERO ERROR COUNT FIELD 63400018 BR XRET2 . RETURN 63600018 DROP CEBASE 63800018 AIF (('&SYS' EQ 'MVT') OR ('&SYS' EQ 'MFT')).SKIP8 63900018 TITLE 'IGC0801C - PROGRAM CONTROLLED INTERRUPT ROUTINE' 64000018 PCIAPP EQU * 64200018 APPBASE EQU 13 64400018 WORK2 EQU 12 64600018 BALR APPBASE,ZERO . ESTABLISH ADDRESSABITY 64800018 USING *,APPBASE . SET BASE REG 65000018 PCIAPP2 EQU * 65200018 L DARREG,CVTPTR . GET CVT ADDR 65400018 L DARREG,DARPTR(DARREG) . GET CONTROL BLOCK PTR 65800018 L SVRBREG,DARTCBSV . GET THE ACTIVE TCB ADDR 66000018 L SVRBREG,ZERO(SVRBREG) . GET THIS RTNS SVRB ADDR 66200018 TEST1 EQU * 66400018 MVC SEEKAD(L4),DARVOID1 . UPDATE SEEK ADDR IN IOB 66600018 OI DARCCW1,MTBIT . MAKE SEARCH FOR MULTI-TRACK 66800018 IC WORK2,HEADNUM . GET HEAD NUMBER 67000018 LA WORK2,K1(WORK2) . ADD ONE TO GET NEXT HEAD 67200018 STC WORK2,HEADNUM . RESTORE 67400018 CLC TRKCNT(L2),DARNOTRK . SEE IF LAST TRK ON CYL 67600018 BNE SETIOB . NOT LAST TRK 67800018 SETCYL EQU * 68000018 MVI HEADNUM,XZERO . SET HEAD TO ZERO 68200018 LH WORK2,DARVOID1 . GET CYL NO. 68400018 LA WORK2,K1(WORK2) . UPDATE TO NEXT CYLINDER 68600018 STH WORK2,DARVOID1 . RESTORE 68800018 SETIOB EQU * 69000018 MVC SEARCHAD(L4),DARVOID1 . SET SEARCH ADDR (CCHH) 69200018 TM ESAFLG(SVRBREG),PCIFLAG .SEE IF 1ST SET OF CCW'S IN USE 69400018 BZ SETUP2 . NO, BRANCH 69600018 LA DARREG,K32(DARREG) . BUMP DARREG TO ACCESS 2ND SET 69800018 * OF CCW'S 70000018 SETUP2 EQU * 70200018 XI ESAFLG(SVRBREG),PCIFLAG .HOUSEKEEP CCW USE FLAG 70400018 EJECT 70600018 * 70800018 * SUBROUTINE TO UPDATE WRITE COUNTER AND WRITE CCW 71000018 * 71200018 SPACE 3 71400018 LA LNKREG,ESCAPE . SET RETURN REG 71600018 UPDATE EQU * 71800018 L WORK2,ESANDX(SVRBREG) . GET ADDR OF THIS WRITE 72000018 AH WORK2,CCW3CNT . ADD RECORD SIZE 72200018 C WORK2,ESAHICNT(SVRBREG) .SEE IF ADDR IS VALID 72400018 BNH OK YES, OK, BRANCH 72600018 L WORK2,ESAHICNT(SVRBREG) .GET HI MACH ADDR 72800018 S WORK2,ESANDX(SVRBREG) . SUBTRACT LAST ADDR WRITTEN 73000018 * RESULT IS REMAINING BYTES TO 73200018 * WRITE 73400018 STH WORK2,CCW3CNT . SET COUNT FOR SHORT RECORD 73600018 MVC CCW3ADR(L3),ESACNT(SVRBREG) SET WRITE ADDR 73800018 MVC ESANDX(L4,SVRBREG),ESAHICNT(SVRBREG) COUNT'S EQUAL 74000018 NI CCW3FLG,NOPCICC . NO COMMAND CHAINING OR PCI 74200018 BR LNKREG . RETURN 74400018 OK EQU * 74600018 MVC CCW3ADR(L3),ESACNT(SVRBREG) SET ADDR FOR WRITE 74800018 ST WORK2,ESANDX(SVRBREG) . SAVE ADDR OF WRITE FOR NEXT 75000018 * PASS THROUGH 75200018 BR LNKREG . RETURN 75400018 ESCAPE EQU * 75600018 SR SVRBREG,SVRBREG . CLEAR FOR IOS 75800018 BR RETREG . RETURN TO IOS 75900018 .SKIP8 ANOP 76000018 TITLE 'IGC0801C - DSECT''S, EQUATES, ETC.' 76200018 AIF ('&SYS' NE 'MVT').SKIP9 76210018 TERMSECT DSECT 76220018 * MAPS THE LOCATOR FIELDS IN ABTERM - MVT 76230018 DS D . ABTERM INSTRS 76240018 PCI1 DS AL4 . DAR PCI APPENDAGE ADDR 76250018 PCI2 DS AL4 . DAR TAPE CTR UPDATE PTR 76260018 .SKIP9 ANOP 76270018 AIF ('&SYS' NE 'MFT').SKIP2 76280018 TERMSECT DSECT 76290018 * MAPS THE LOCATOR FIELDS IN ABTERM - MFT 76300018 DS D . ABTERM INSTRS 76310018 DS AL4 . IEEMSIRB 76320018 DS AL4 . IEA0EQ01 76330018 DS AL4 . LEQC 76340018 DS AL4 . TRSTOPER 76350018 PCI1 DS AL4 . DAR - PCI APP RTN 76360018 PCI2 DS AL4 . DAR - TAPE UPDATE RTN 76370018 .SKIP2 ANOP 76380018 DARMAC 76400018 MEND 76600018 ./ ADD SSI=01030071,SOURCE=1,NAME=ENDUP MACRO 10000000 &NAME ENDUP &DUMMY,&FTYPE= 20000000 GBLA &RAFIOPR,&RAFIORG 30000000 VALARG (&DUMMY),(1,),(&FTYPE),(3,,GBL,XGBL) 40000000 RAFIOARG (&FTYPE,ENDUP) 50000000 &NAME LA &RAFIORG,&RAFIOPR 60000000 RCALL AFIO 70000000 MEND 80000000 ./ ADD SSI=01010070,SOURCE=1,NAME=EQUATES MACRO 00050021 EQUATES 00100021 SPACE 00150021 *********************************************************************** 00200021 * * 00250021 ** **** E Q U A T E S **** ** 00300021 * * 00350021 *********************************************************************** 00400021 SPACE 00450021 R0 EQU 0 00500021 R1 EQU 1 00550021 R2 EQU 2 00600021 R3 EQU 3 00650021 R4 EQU 4 00700021 R5 EQU 5 00750021 R6 EQU 6 00800021 R7 EQU 7 00850021 R8 EQU 8 00900021 R9 EQU 9 00950021 R10 EQU 10 01000021 R11 EQU 11 01050021 R12 EQU 12 01100021 R13 EQU 13 01150021 R14 EQU 14 01200021 R15 EQU 15 01250021 RETREG EQU 14 01300021 COMBASE EQU 12 01350021 BASE1 EQU 11 01400021 BASE2 EQU 10 01450021 BASE3 EQU 9 01500021 STOPBASE EQU 5 01550021 LINEREG EQU 8 01600021 BUFREG EQU 6 01650021 CNTREG EQU 3 01700021 PREG EQU 1 01750021 ************************************** 01800021 STORSW EQU 128 * 01850021 READINIT EQU 64 * 01900021 JBNMSW EQU 32 * 01950021 TSOSW EQU 16 * ** SWA ** 02000021 GOSW EQU 8 * 02050021 PRNTSW EQU 4 * 02100021 SETCVTSW EQU 2 * 02150021 RDRSW EQU 1 * 02200021 ************************************** 02250021 IOERR EQU 128 * 02300021 FMTERR EQU 64 * 02350021 SEQ1 EQU 16 * ** SWB ** 02400021 ENDSW EQU 8 * 02450021 SP252 EQU 4 * 02500021 SP251 EQU 2 * 02550021 REWIND EQU 1 * 02600021 ************************************** 02650021 MSTRSW EQU 128 * 02700021 NEWDMPSW EQU 64 * 02750021 POSITSW EQU 32 * 02800021 TREADIN EQU 16 * 02850021 EDITSW EQU 8 * S21014 02900021 OPT4 EQU 4 * ** SWC ** 02950021 OPT2 EQU 2 * 03000021 OPT1 EQU 1 * 03050021 ************************************** 03100021 FLSHMODE EQU 128 * 03150021 SWPDCBCL EQU 64 * 03200021 INCDUMP EQU 32 * 03250021 NOSTDMG EQU 16 * S21014 03300021 PREFMTD EQU 8 * ** SWD ** 03350021 CONTSW EQU 4 * S21014 03400021 GPRSFND EQU 2 * 03450021 FRBUFSW EQU 1 * 03500021 ************************************** 03550021 STOPSW EQU 128 * 03600021 MVTSW EQU 64 * 03650021 RESPC EQU 32 * M1743 03700021 TITLESW EQU 16 * ** SWE ** 03750021 READLDD EQU 8 * 03800021 FMTDSW EQU 4 * 03850021 MFTSW EQU 2 * 03900021 MFTATCH EQU 1 * 03950021 ************************************** 04000021 LFTPAREN EQU 128 * 04050021 MORE EQU 64 * ** PRSW ** 04100021 ERRSW EQU 32 * 04150021 TTLSW EQU 16 * S21016 04160021 ************************************** 04200021 READMDIN EQU 128 * INDICATES READ MODULE HAS BEEN LOADED M1744 04250021 RDSWAPIN EQU 64 * 04300021 TCLSE EQU 32 * 04350021 BUFSGTN EQU 16 * 04400021 EOFSW EQU 8 * ** BUFSW ** 04450021 HIGHSW EQU 4 * 04500021 PREFM EQU 2 * 04550021 RDBACK EQU 1 * 04600021 ************************************** 04650021 SQ1 EQU 128 * ** PRFMSW ** 04700021 SQ2 EQU 64 * 04750021 ************************************** 04800021 * * ** FMTPTRN FLAG BYTE EQU'S ** 04850021 DTAE EQU 32 * DATA EBCDIC BIT 04900021 DTAC EQU 16 * DATA IN CORE BIT 04950021 DTAP EQU 8 * DATA PTR BIT 05000021 DTA EQU 4 * DATA INCLUDED BIT 05050021 LBLP EQU 2 * LABEL PTR BIT 05100021 LBL EQU 1 * LABEL INCLUDED BIT 05150021 ************************************* 05200021 DCBOPEN EQU 16 05250021 RDBKWRD EQU 64 05300021 SISTER EQU 128 05350021 MOTHER EQU 132 05400021 DAUGHTER EQU 136 05450021 TCBTIOT EQU 12 05500021 TCBPQE EQU 152 05550021 TCBSPQE EQU 24 05600021 TCBMSS EQU 24 05650021 TCBNEXT EQU 116 05700021 TCBFLGS EQU 29 05750021 ROLLOUT EQU 16 05800021 SHRSPQE EQU 128 05850021 OWNSPQE EQU 32 05900021 LASTSPQE EQU 64 05950021 MINCDE EQU 4 06000021 TCBLLEP EQU 36 06050021 JOBLAST EQU 128 06100021 JOBVALID EQU 64 06150021 JSTCB EQU 124 06200021 MFTJST EQU 44 06250021 JBFNDBIT EQU 32 06300021 TIOTLNGH EQU 40 06350021 TIMER EQU 80 06400021 BRWD1 EQU 128 06450021 BRWD2 EQU 32 06500021 RLD EQU 64 06550021 PQEFPQE EQU 8 06600021 PQESIZE EQU 20 06650021 PQEREGN EQU 24 06700021 PQERFLGS EQU 28 06750021 IEAQQCBO EQU 20 06800021 DCBIOB EQU 68 06850021 CMPLT EQU 64 06900021 BLKSIZE EQU 62 06950021 LRECL EQU 82 07000021 BUFNOA EQU 20 07050021 EJECT 07100021 MEND 07150021 ./ ADD SSI=01011920,SOURCE=1,NAME=ERM * %GO TO DCLERM; /* 01000021 MACRO 02000021 &L ERM 03000021 .*A000000-999999 S21014 03050021 AIF ('&L' EQ '').ERML 04000021 &L DSECT , ERROR MONITOR TABLE 05000021 AGO .ERMN 06000021 .ERML ANOP 07000021 ERM DSECT , ERROR MONITOR TABLE 08000021 .ERMN ANOP 09000021 ERMFLGS DS XL1 ERM FLAGS 10000021 ERMINCTL EQU 128 ERROR RECOVERY MON IN CONTROL 11000021 ERMNTERM EQU 64 NTERM WAS ISSUED 12000021 ERMATERM EQU 32 ATERM WAS ISSUED 13000021 ERMSTOPD EQU 16 STOPPED FROM CONSOLE 14000021 ERMDUMP EQU 8 DUMP REQUESTED 15000021 ERMPIAP EQU 4 PGM CHECK IN APPLICATION 16000021 ERMSVCAP EQU 2 SVC ISSUED IN APPLICATION 17000021 ERMCODE DS XL3 COMPLETION CODE 18000021 ERMECB DS A RMON TERMINATION ECB ADDR 19000021 ERMOPSW DS DL8 OLD PSW AT TERMINATION 20000021 ERMREGS DS 16F REGISTERS AT TERMINATION (0-15) 21000021 ERMROUTE DS A IHLROUTE ENTRY POINT 22000021 ERMCRCB DS A CURRENT RCB AT TERMINATION 23000021 ERMCMCT DS A CURRENT MCT SUBENTRY AT TERM 24000021 ERMHFL1 DS XL1 HCTFLG1 AT TERMINATION 25000021 DS XL1 RESERVED 26000021 ERMNERM DS FL2 NUMBER OF ERM SUBENTS 27000021 ERMSUB DS 10CL6 ERM SUBENTRIES 28000021 ERMSUBEN DSECT , ERM SUBENTRY 29000021 ERMSFLG DS XL1 SUBENTRY FLAG FIELD 30000021 ERMSMUST EQU 128 MUST BE CALLED FLAG 31000021 ERMAID DS XL1 AID OF CORRESPONDING APPL 32000021 ERMADDR DS AL4 TERMAD ADDR 33000021 MEND , */ 34000021 * %DCLERM: ; 35000021 * DCL 1 ERM BASED(HCTERM), /* ERROR RECVRY MONT TAB*/ 36000021 * 2 ERMFLGS BIT(8), /* ERM STATUS FLAGS */ 37000021 3 ERMINCTL BIT(1), /* ERROR RECVY IN CONTRL*/ 38000021 * 3 ERMNTERM BIT(1), /* NTERM ISSUED */ 39000021 * 3 ERMATERM BIT(1), /* ATERM ISSUED */ 40000021 * 3 ERMSTOPD BIT(1), /* STOPPED FROM CONSOLE */ 41000021 * 3 ERMDUMP BIT(1), /* DUMP REQUESTED */ 42000021 * 3 ERMPIAP BIT(1), /* PGM CHECK IN APPL */ 43000021 * 3 ERMSVCAP BIT(1), /* SVC IN APPL */ 44000021 * 3 * BIT(1), /* RESERVED */ 45000021 * 2 ERMCODE CHAR(3), /* COMPLETION CODE */ 46000021 * 2 ERMECB PTR(31), /* RMON'S TRMNTN ECB AD */ 47000021 * 2 ERMOPSW CHAR(8), /* OPSW AT TERMNATN */ 48000021 * 2 ERMREGS, /* REGISTERS AT TERMNATN*/ 49000021 * 3 ERMGREG(16) PTR(31), /* STORED 0-15 */ 50000021 * 2 ERMROUTE PTR(31), /* IHLROUTE ENTRY POINT */ 51000021 * 2 ERMCRCB PTR(31), /* CURRENT RCB AT TERM */ 52000021 * 2 ERMCMCT PTR(31), /*CURRENT MCT SUBENTRY */ 53000021 * /* AT TERMINATION */ 54000021 * 2 ERMHFL1 BIT(8), /* HCTFLG1 AT TERMNATN */ 55000021 * 2 * BIT(8), /* RESERVED */ 56000021 * 2 ERMNERM FIXED(15), /* NUMBER OF ERM SUBENTS*/ 57000021 * 2 ERMSUB(10) CHAR(6), /* SUBENTRIES (MAX 10) */ 58000021 3 ERMSFLG BIT(8), /* SUBENTRY FLAG FIELD */ 59000021 4 ERMSMUST BIT(1), /* MUST BE CALLED FLAG */ 60000021 * 3 ERMAID CHAR(1), /* CORRSPNDING APPL AID */ 61000021 * 3 ERMADDR PTR(31) BDY(BYTE); /* TERMAD ADDR */ 62000021 ./ ADD SSI=01030071,SOURCE=1,NAME=EXCCWDS MACRO 00500000 EXCCWDS &TYPE=DSECT 01000000 AIF ('&TYPE' EQ 'DSECT').GO 01500000 IHKEXC CSECT CHANNEL PROGRAM EXECUTOR 02000000 AGO .GO2 02500000 .GO ANOP 03000000 EXCCWDS DSECT , DEFINITION OF EXCCW MODULE LINKAGE 03500000 MASTREQ EQU * 04000000 ONEARG EQU * 04500000 SIMPLE EQU * 05000000 NDXREQ EQU * 05500000 NDXINTEX EQU * 06000000 CHKNDXEX EQU * 06500000 LOCNDXEX EQU * 07000000 DELNDXEX EQU * 07500000 RELESEX EQU * 08000000 OLDNDX8 EQU * 08500000 OLNDXCCW EQU * 09000000 OLDNDXEX EQU * 09500000 MAST1EX EQU * 10000000 SRCHRQ EQU * 10500000 SRCHPTRQ EQU * 11000000 SRCHXKRQ EQU * 11500000 SRCHEX EQU * 12000000 NDUPRQ EQU * 12500000 NDUPSQRQ EQU * 13000000 NDUPMDRQ EQU * 13500000 NDUPEX EQU * 14000000 FRSTMVRQ EQU * 14500000 FRSTMDRQ EQU * 15000000 FRSTMVEX EQU * 15500000 NEWINSRQ EQU * 16000000 NEWINSEX EQU * 16500000 OLDINSRQ EQU * 17000000 OLDINSEX EQU * 17500000 INSRQ EQU * 18000000 INSEX EQU * 18500000 RLSTUPRQ EQU * 19000000 RLSTUPEX EQU * 19500000 RLSTINRQ EQU * 20000000 RLSTINEX EQU * 20500000 NDXRQ EQU * 21000000 NDXSEQRQ EQU * 21500000 NDXPNTRQ EQU * 22000000 NDXINBRQ EQU * 22500000 NDXRQ1 EQU * 23000000 NDXUEX2 EQU * 23500000 RDXKRQ EQU * 24000000 RDXKEX EQU * 24500000 GETRQ EQU * 25000000 GETEX EQU * 25500000 REPEX EQU * 26000000 REPRQ EQU * 26500000 SKIPRQ EQU * 27000000 .GO2 ANOP 27500000 EX EQU * . ORIGIN OF LINKAGE AND REQUESTOR TABLE 28000000 GENMASBQ EQU *-EX . GENERATE MASTER INDEX (REQUESTOR). 28500000 DC Y(MASTREQ-EX) . 29000000 DK 9 . NINE CCW'S 29500000 DK 3 . AND THREE SEARCH ARGUMENTS 30000000 GENMASBX EQU *-EX . GENERATE MASTER INDEX (EXECUTOR). 30500000 DC Y(ONEARG-EX) . 31000000 DC Y(SIMPLE-EX) 31500000 DC Y(GENMASCW) . 32000000 NDXINTBQ EQU *-EX . FORMAT INDEX RECORD TRACK 32500000 DC Y(NDXREQ-EX) . (REQUESTOR). 33000000 DK 10 . TEN CCW'S 33500000 DK 2 . TWO SERACH ARGUMENTS 34000000 NDXINTBX EQU *-EX . INDEX RECORD FORMAT (EXECUTOR). 34500000 DC Y(ONEARG-EX) . 35000000 DC Y(SIMPLE-EX) . 35500000 DC Y(NDXINTCW) . 36000000 CHKNDXBQ EQU *-EX . CHECKPOINT ADDRESS OF INDEX RECORD 36500000 DELNDXBQ EQU *-EX . RESET MASTER INDEX ENTRY (REQUESTOR). 37000000 DC Y(MASTREQ-EX) . (REQUESTOR). 37500000 DK 6 . SIX CCW'S 38000000 DK 1 . AND ONE SEARCH ARGUMENT 38500000 CHKNDXBX EQU *-EX . CHECKPOINT INDEX RECORD ADDRESS 39000000 DC Y(ONEARG-EX) . 39500000 DC Y(CHKNDXEX-EX) . IN MASTER INDEX (EXECUTOR). 40000000 DC Y(CHKNDXCW) . 40500000 LOCNDXBQ EQU *-EX . LOCATE INDEX TRACK THROUGH MASTER 41000000 MAST1BQ EQU *-EX . LOC 1ST DATA REC. THRU MASTER REQ. 41500000 DC Y(MASTREQ-EX) . 42000000 DK 3 . THREE CCW'S 42500000 DK 1 . AND ONE SEARCH ARGUMENT 43000000 LOCNDXBX EQU *-EX . LOCATE INDEX TRACK THROUGH MASTER 43500000 DC Y(ONEARG-EX) . 44000000 DC Y(LOCNDXEX-EX) . INDEX (EXECUTOR). 44500000 DC Y(LOCNDXCW) . 45000000 DELNDXBX EQU *-EX . DELETE MASTER INDEX ENTRY 45500000 DC Y(ONEARG-EX) . 46000000 DC Y(DELNDXEX-EX) . (EXECUTOR). 46500000 DC Y(DELNDXCW) . 47000000 RELESBQ EQU *-EX . RELEASE ALL DATA TRACKS 47500000 DC Y(NDXRQ1-EX) . (REQUESTOR). 48000000 RELESBX EQU *-EX . RELEASE ALL DATA TRACKS 48500000 DC Y(ONEARG-EX) . 49000000 DC Y(RELESEX-EX) . IN FILE (EXECUTOR). 49500000 DC Y(NDXUCW) . 50000000 OLDNDXBQ EQU *-EX . OLD INDEX REQUESTOR ROUTINE 50500000 DC Y(NDXREQ-EX) . 51000000 DK (OLDNDX8-OLNDXCCW)/8 . NUMBER OF CCW'S 51500000 DK 4 . FOUR SEARCH ARGUMENTS 52000000 OLDNDXBX EQU *-EX . OLD INDEX EXECUTOR ROUTINE 52500000 DC Y(ONEARG-EX) . 53000000 DC Y(OLDNDXEX-EX) . 53500000 DC Y(OLDXCCWS) . 54000000 MAST1BX EQU *-EX . LOCATE FIRST DATA RECORD THROUGH 54500000 DC Y(ONEARG-EX) . 55000000 DC Y(MAST1EX-EX) . MASTER INDEX EXECUTOR 55500000 DC Y(MAST1CW) . 56000000 SRCHBQ EQU *-EX . POSITION WITHIN NEW SEGMENT REQUESTOR 56500000 DC Y(SRCHRQ-EX) . 57000000 SRCHPTBQ EQU *-EX . POSITION WITHIN NEXT SEQUENTIAL 57500000 DC Y(SRCHPTRQ-EX) . SEGMENT REQUESTOR 58000000 SRCHXKBQ EQU *-EX . READ RECORD CHAIN AND POSSIBLY XKEY 58500000 DC Y(SRCHXKRQ-EX) . REQUESTOR 59000000 SRCHBX EQU *-EX . POSITION WITHIN NEW SEGMENT EXECUTOR 59500000 SRCHPTBX EQU *-EX . POSITION WITHIN NEXT SEQUENTIAL 60000000 SRCHXKBX EQU *-EX . 60500000 DC Y(SRCHEX-EX) . 61000000 NDUPBQ EQU *-EX . UPDATE PRESENT CHAIN RECORD REQUESTOR 61500000 DC Y(NDUPRQ-EX) . 62000000 NDUPSQBQ EQU *-EX . UPDATE CHAIN RECORD AND PROCEDE TO 62500000 DC Y(NDUPSQRQ-EX) . NEXT SEGMENT REQUESTOR 63000000 NDUPMDBQ EQU *-EX . UNCONDITIONAL UPDATE OF CHAIN RECORD 63500000 DC Y(NDUPMDRQ-EX) . REQUESTOR 64000000 NDUPBX EQU *-EX . UPDATE PRESENT CHAIN RECORD EXECUTOR 64500000 NDUPSQBX EQU *-EX . UPDATE CHAIN RECORD AND PROCEDE TO 65000000 NDUPMDBX EQU *-EX . UNCONDITIONAL UPDAE OF CHAIN RECORD 65500000 DC Y(NDUPEX-EX) . 66000000 FRSTMVBQ EQU *-EX . CONDITIONAL UPDATE OF END OF SEGMENT 66500000 DC Y(FRSTMVRQ-EX) . POINTER REQUESTOR 67000000 FRSTMDBQ EQU *-EX . UNCONDITIONAL UPDATE OF END OF 67500000 DC Y(FRSTMDRQ-EX) . SEGMENT POINTER REQUESTOR 68000000 FRSTMVBX EQU *-EX . UPDATE EOS OF PREVIOUS SEGMENT 68500000 FRSTMDBX EQU *-EX . OR MASTER INDEX 69000000 DC Y(FRSTMVEX-EX) . EXECUTOR 69500000 NEWINSBQ EQU *-EX . FORMAT DATA TRACK AND INSERT ONE OR 70000000 DC Y(NEWINSRQ-EX) . MORE RECORDS REQUESTOR 70500000 NEWINSBX EQU *-EX . FORMAT DATA TRACK AND INSERT ONE OR 71000000 DC Y(NEWINSEX-EX) . MORE RECORDS EXECUTOR 71500000 OLDINSBQ EQU *-EX . INSERT SINGLE RECORD AND GENERATE 72000000 DC Y(OLDINSRQ-EX) . NEW EOS IN TRACK CHAIN REQUESTOR 72500000 OLDINSBX EQU *-EX . INSERT RECORD AND GENERATE NEW EOS 73000000 DC Y(OLDINSEX-EX) . ENTRY IN TRACK CHAIN EXECUTOR 73500000 INSBQ EQU *-EX . INSERT SINGLE DATA RECORD REQUESTOR 74000000 DC Y(INSRQ-EX) . 74500000 INSBX EQU *-EX . INSERT RECORD(S) (REQUESTOR) 75000000 DC Y(INSEX-EX) . 75500000 RLSTUPBQ EQU *-EX . LOCATE TRACK LIST ENTRY FOR PRESENT 76000000 DC Y(RLSTUPRQ-EX) . TRACK REQUESTOR 76500000 RLSTUPBX EQU *-EX . LOCATE TRACK LIST ENTRY FOR PRESENT 77000000 RLSTINBX EQU *-EX . TRACK OR LOCATE HOLE IN FILE 77500000 DC Y(RLSTUPEX-EX) . 78000000 RLSTINBQ EQU *-EX . LOCATE TRACK LIST ENTRY AND SCAN FOR 78500000 DC Y(RLSTINRQ-EX) . HOLE REQUESTOR 79000000 NDXBQ EQU *-EX . UPDATE AND SCAN INDEX RECORD 79500000 DC Y(NDXRQ-EX) . REQUESTOR 80000000 NDXSEQBQ EQU *-EX . UPDATE INDEX RECORD AND PROCEDE TO 80500000 DC Y(NDXSEQRQ-EX) . NEXT SEGMENT REQUESTOR 81000000 NDXPNTBQ EQU *-EX . POINT INDEX UPDATE REQUESTOR 81500000 DC Y(NDXPNTRQ-EX) . 82000000 NDXINBBQ EQU *-EX . BSR INDEX UPDATE REQUESTOR 82500000 DC Y(NDXINBRQ-EX) . 83000000 NDXBX EQU *-EX . UPDATE AND SCAN INDEX RECORD 83500000 NDXSEQBX EQU *-EX . UPDATE INDEX RECORD AND PROCEDE TO 84000000 NDXPNTBX EQU *-EX . POINT INDEX UPDATE EXECUTOR 84500000 NDXINBBX EQU *-EX . BSR INDEX UPDATE EXECUTOR 85000000 DC Y(ONEARG-EX) . 85500000 DC Y(NDXUEX2-EX) . 86000000 DC Y(NDXUCW) . 86500000 RDXKBQ EQU *-EX . READ NEXT KEY REQUESTOR 87000000 DC Y(RDXKRQ-EX) . 87500000 RDXKBX EQU *-EX . READ NEXT KEY EXECUTOR 88000000 DC Y(RDXKEX-EX) . 88500000 GETBQ EQU *-EX . DATA RECORD RETRIEVAL (REQUESTOR) 89000000 DC Y(GETRQ-EX) . 89500000 GETBX EQU *-EX . DATA RECORD RETRIEVAL (EXECUTOR) 90000000 DC Y(GETEX-EX) . 90500000 REPBX EQU *-EX . REPLACE DATA RECORD (EXECUTOR) 91000000 DC Y(REPEX-EX) . 91500000 REPBQ EQU *-EX . REPLACE RECORD (REQUESTOR) 92000000 DC Y(REPRQ-EX) . 92500000 SKIPBQ EQU *-EX . SKIP RECORD 93000000 DC Y(SKIPRQ-EX) . 93500000 MEND 94000000 ./ ADD SSI=01030071,SOURCE=1,NAME=EXCPFWDS MACRO 01000000 EXCPFWDS &TYPE=DSECT 02000000 * 03000000 * ACTIVE FILE I/O TEMPORARY WORK AND CONSTANT AREA 04000000 * 05000000 AIF ('&TYPE' EQ 'DSECT').GO 06000000 &TYPE CSECT . ACTIVE FILE WORK/CONSTANT AREA 07000000 AGO .GO2 08000000 .GO ANOP 09000000 EXCPFWDS DSECT . ACTIVE FILE WORK/CONSTANT DEFINITION 10000000 .GO2 ANOP 11000000 * 12000000 VARIOFW DS 0CL32 . VARIABLE PORTION OF WORK/CONSTANTS 13000000 VARIO1FW DS 0CL16 . RECORD DEFINITION AREA 14000000 ULKDFW DC H'0' . LENGTH OF USER'S RECORD KEY FIELD 15000000 UMLKDFW DC H'0' . MACHINE LENGTH OF KEY FIELD 16000000 ULDDFW DC H'0' . LENGTH OF USER'S RECORD DATA FIELD 17000000 ULKDDFW DC H'0' . COMBINED KEY & DATA LENGTH 18000000 ULKCFW DC H'0' . LENGTH OF TRACK CHAIN 19000000 ULDCFW DC H'0' . LENGTH OF RECORD CHAIN 20000000 UNORECFW EQU ULDCFW . NUMBER OF DATA RECORDS PER TRACK 21000000 UMLDCFW DC H'0' . MACHINE LENGTH OF RECORD CHAIN 22000000 UDNRECFW DC H'0' . MAXIMUM RECORD NUMBER ON TRACK 23000000 VARIO2FW DS 0CL10 . BUFFER DEFINITION AREA 24000000 BLKSZFW DC H'0' . PHYSICAL LENGTH OF USER'S BUFFER 25000000 ULLRECFW DC H'0' . LENGTH OF USER'S LOGICAL BUFFER 26000000 UADKEYFW DC H'0' . REL. POS. OF KEY IN BUFFER 27000000 UADDATFW DC H'0' . REL. POS. OF TEXT FROM KEY 28000000 UADNKYFW DC H'0' . REL. POS. OF NEXT KEY FROM TEXT 29000000 NXTKEYFW DC A(0) . USER KEY FIELD POINTER 30000000 EXRETLK DC A(0) . EXECUTOR RETURN ADDRESS 31000000 EXRET2LK DC A(0) . ALTERNATE EXECUTOR RET AND GEN RET 32000000 WKDATAFW DC F'0' . 33000000 AIF ('&TYPE' EQ 'IHKEXF' OR '&TYPE' EQ 'DSECT').GO3 34000000 MEXIT 35000000 .GO3 ANOP 36000000 EXTENDFW EQU * . N OF EXECUTOR DEPENDENT WORK AREA 37000000 CCWRGFW DC A(0) . CCW LIST ORIGIN - 8 38000000 SRCHRGFW DC A(0) . SEARCH ARGUMENT LIST ORIGIN - 8 39000000 IOB DS 0F . IOB DEF. (INPUT/OUTPUT BLOCK) 40000000 IOBFLAG1 DC B'11000010' . UNRELATED, COMMAND/DATA CHAINING 41000000 IOBERR EQU B'00100000' ERROR ROUTINE IN CONTROL 42000000 IOBXCPTN EQU B'00000100' ERROR PENDING OR PERMANENT 43000000 IOBFLAG2 DC X'00' . 44000000 IOBSENS0 DC X'00' . SENSE BYTES 45000000 IOBSENS1 DC X'00' . 46000000 TRKOVRUN EQU B'01000000' TRACK OVER RUN 47000000 NORECFND EQU B'00001000' NO RECORD FOUND 48000000 IOBECBCC DS 0CL1 . IOS ECB CC CODE (FIRST BYTE) 49000000 PERMERR EQU B'00100000' . =0 IF PERMANENT ERROR 50000000 IOBECBPT DC A(ECB) . ECB ADDRESS POINTER 51000000 IOBFLAG3 DS 0CL1 . 52000000 IOBCSW DC XL8'0' . CHANNEL END CSW 53000000 ILI EQU B'01000000' INCORRECT LENGTH INDICATION 54000000 IOBSIOCC DS 0CL1 . SIO CONDITION CODE 55000000 IOBSTART DC A(0) . CHANNEL PROGRAM POINTER 56000000 DS 0CL1 . 57000000 IOBDCBPT DC A(ACTIVDCB) . DCB POINTER 58000000 DS 0CL1 . 59000000 IOBRESTR DC A(0) . IOS CHANNEL PROGRAM RESTART ADDRESS 60000000 IOBINCAM DC H'0' . BLOCK COUNT INCREMENT (TAPE ONLY) 61000000 IOBERRCT DC H'0' . ERROR RETRY COUNT 62000000 IOBSEEK DC XL8'0' . MBBCCHHR EXTEND AND SEEK ADDRESS 63000000 ECB DC F'0' . IOS EVENT CONTROL BLOCK 64000000 ACTIVDCB DCB DSORG=DAU,MACRF=(E),DEVD=DA,DDNAME=ACTIVE 65000000 * 66000000 * TEMPORARY STORAGE USED FOR SEARCH ARGUMENTS, CCW LISTS, AND SAVE AREA 67000000 * 68000000 TMPAREA0 DS 0F 69000000 MINXTND EQU *-EXTENDFW 70000000 INSDTRAN DS CL12 71000000 REPDTRAN DS CL12 72000000 TMPAREA1 DS 0F 73000000 MINXTND1 EQU *-EXTENDFW 74000000 ORG TMPAREA0 75000000 SAV1 DS F 76000000 SAV2 DS F 77000000 TMPAREA2 DS 0F 78000000 MINXTND2 EQU *-EXTENDFW 79000000 DS CL4000 . MAXIMUM EXTRA STORAGE NEEDED 80000000 * 81000000 MEND 82000000 ./ ADD SSI=01030072,SOURCE=1,NAME=FDIDS MACRO 06000000 FDIDS 12000000 * 18000000 * 24000000 FDIDSDS DSECT , PBAM DIRECTORY ENTRY 30000000 DS 2F . STORAGE ALLOCATOR CONTROL WORDS 36000000 ACTDATA DS H . COUNT OF NUMBER OF ACTIVE BYTES 42000000 NAME DS CL8 . MEMBER NAME 48000000 TTR DS CL3 . TRACK AND RECORD ADDRESS OF BEG 54000000 DATALEN DS X . # HALF WORDS OF USER INFO 60000000 FDIDS DS 0C . CRBE FDI 66000000 USERDATA DS 28C 72000000 FDILEN EQU (*-FDIDS)/2 . LENGTH OF FDI 78000000 MEND 84000000 ./ ADD SSI=30240393,NAME=FDIMEN,SOURCE=0 MACRO 00020000 FDIMEN &GRA=4,&GRB=5,&GRC=6,&GRD=7,&SP1=10,&SP2=11,&SRR=9 00040000 .* RELEASE 19 DELETIONS * 00044019 .* A27005 00048019 .* RELEASE 20 DELETIONS * 00052019 .* 046200,047300 I000 00053020 .* I004 00054020 .* A28596 00054620 .* A32954 00055220 .* RELEASE 21 DELETIONS * 00056019 .* 066000 A52831 00056421 MNOTE *,'FV2 CENTRAL DIMENSIONING DECK--04/14/66' 00060000 MNOTE *,'... SEE IEURTA FOR THE MACRO EXPANSION...' 00070013 * 00080000 ******** GENERAL REGISTER SYMBOLIC ASSIGNMENTS ************************ 00100000 * VARIABLE REGISTRS--MAY BE SPECIFIED TO NON-STANDARD VALUES 00120000 SRR EQU &SRR COMMON SUBROUTINE RETURN ADDRESS ODD CONTIG. 00140000 SP1 EQU &SP1 COMMON SUBROUTINE PARAMETER 1 EVEN 00160000 SP2 EQU &SP2 COMMON SUBROUTINE PARAMETER 2 ODD 00180000 GRA EQU &GRA LEVEL 0-1 GP REG A EVEN A-D CONTIGUOUS 00200000 GRB EQU &GRB LEVEL 0-1 GP REG B ODD 00220000 GRC EQU &GRC LEVEL 0-1 GP REG C 00240000 GRD EQU &GRD LEVEL 0-1 GP REG D 00260000 ACT EQU 3 ASSEMBLER CONTROL TABLE POINTER 00280000 SRB EQU 8 COMMON SUBROUTINE BASE ADDRESS EVEN SRB-SP1 00300000 GRX EQU 14 GENERAL PURPOSE REG X EVEN X-Y CONTIGUOUS 00320000 GRY EQU 15 GENERAL PURPOSE REG Y ODD 00340000 GRZ EQU 13 GENERAL PURPOSE REG Z 00360000 FRB EQU 12 FUNCTIONAL ROUTINE BASE ADDRESS 00380000 CRB EQU GRC MAIN LINE CONTROL BASE ADDRESS 00400000 CRR EQU GRD MAIN LINE CONTROL RETURN ADDRESS 00420000 GR0 EQU 0 00440000 GR1 EQU 1 00460000 GR2 EQU 2 00480000 EJECT 00500000 ******** INTERNAL CHARACTER CODES ************************************* 00520000 IZERO EQU X'00' NUMBERS 00540000 I1 EQU X'01' 00560000 I2 EQU X'02' 00580000 I3 EQU X'03' 00600000 I4 EQU X'04' 00620000 I5 EQU X'05' 00640000 I6 EQU X'06' 00660000 I7 EQU X'07' 00680000 I8 EQU X'08' 00700000 I9 EQU X'09' 00720000 IA EQU X'0A' LETTERS 00740000 IB EQU X'0B' 00760000 IC EQU X'0C' 00780000 ID EQU X'0D' 00800000 IE EQU X'0E' 00820000 IF EQU X'0F' 00840000 IG EQU X'10' 00860000 IH EQU X'11' 00880000 II EQU X'12' 00900000 IJ EQU X'13' 00920000 IK EQU X'14' 00940000 IL EQU X'15' 00960000 IM EQU X'16' 00980000 IN EQU X'17' 01000000 IO EQU X'18' 01020000 IP EQU X'19' 01040000 IQ EQU X'1A' 01060000 IR EQU X'1B' 01080000 IS EQU X'1C' 01100000 IT EQU X'1D' 01120000 IU EQU X'1E' 01140000 IV EQU X'1F' 01160000 IW EQU X'20' 01180000 IX EQU X'21' 01200000 IY EQU X'22' 01220000 IZ EQU X'23' 01240000 IDOLLR EQU X'24' EXTRA LETTERS 01260000 IPOUND EQU X'25' 01280000 IAT EQU X'26' 01300000 IPLUS EQU X'27' SPECIAL CHARACTERS 01320000 IMINUS EQU X'28' 01340000 IMULT EQU X'29' 01360000 IASTER EQU X'29' 01380000 IDIVID EQU X'2A' 01400000 ICOMMA EQU X'2B' 01420000 IEQUAL EQU X'2C' 01440000 IAMPSD EQU X'2D' 01460000 IPRIOD EQU X'2E' 01480000 ILPARN EQU X'2F' 01500000 IRPARN EQU X'30' 01520000 IQUOTE EQU X'31' 01540000 IBLANK EQU X'32' 01560000 IALPHA EQU IAT LAST ALPHA CHARACTER 01580000 EJECT 01600000 CT1C EQU 40 TOTAL LENGTH OF CT1 01640000 CT2C EQU 20 NUMBER OF FUNCTIONAL ROUTINES 01660000 CT3C EQU 10 NUMBER OF COMMON SUBROUTINES 01680000 CT4C EQU 32 NUMBER OF COMMON DATA AREAS 01700000 CT5C EQU 640 TOTAL LENGTH OF CENTRAL TABLE 01720000 CT6C EQU 1250 LENGTH OF INTERNAL TEXT BUFFER 01740000 CT1 EQU 0 01760000 CT2 EQU CT1+CT1C 01780000 CT3 EQU CT2+4*CT2C 01800000 CT4 EQU CT3+4*CT3C 01820000 CT5 EQU CT4+4*CT4C 01840000 CT6 EQU CT5+CT5C 01860000 CTRTRN EQU CT1+16 PLC RETURN FOR FUNCTIONAL ROUT 01880000 CTLNK2 EQU CT1+6 MLC LINKAGE ALGORITM FOR ESD 01900000 CTDUMP EQU CT6+CT6C 01920000 CTSAVE EQU CTLNK2+18 CONTROL AEGISTER SAVE AREA 01940000 ******** CT2 DISPLACEMENT VALUES FOR FUNCTIONAL ROUTINE BASE ADDRESSES 01960000 CBRNDA EQU CT2+00 BRENDA 01980000 CDCVAL EQU CT2+52 DCEVAL 02000000 CLTVAL EQU CT2+56 LITVAL 02020000 CTXGET EQU CT2+60 TXGET 02040000 ASOPRO EQU CT2+64 ENTRY TO ASSEMBLER OP PROCESSOR 02060000 MACHOP EQU CT2+68 ENTRY TO MACHINE OP PROCESSOR 02080000 PRNT EQU CT2+72 ENTRY TO PRINT ROUTINE 02100000 CTESTR EQU CT2+76 02120000 ******** ESD FUNCTIONAL ROUTINE ENTRY POINTS ************************** 02140000 CCOM EQU CT2+04 COM (BRENDA) 02160000 CCSECT EQU CT2+08 CSECT (BRENDA) 02180000 CDSECT EQU CT2+12 DSECT (BRENDA) 02200000 CENTRY EQU CT2+16 ENTRY (BRENDA) 02220000 CENTRS EQU CT2+20 ENTRYS(BRENDA) 02240000 CESWBK EQU CT2+24 ESWBKR(BRENDA) 02260000 CEXTRN EQU CT2+28 EXTRN (BRENDA) 02280000 CEXTRS EQU CT2+32 EXTRNS(BRENDA) 02300000 CORG EQU CT2+36 ORG (BRENDA) 02320000 CQUIT EQU CT2+40 QUIT (BRENDA) 02340000 CSTART EQU CT2+44 START (BRENDA) 02360000 CUPC EQU CT2+48 UPC (BRENDA) 02380000 CDXD EQU CT2+64 CXD (BRENDA) 02400000 ******** CT3 DISPLACEMENT VALUES FOR COMMON SUBROUTINE BASE ADDRESSES * 02420000 CTXTIO EQU CT3+00 TEXTIO 02440000 CSTGET EQU CT3+04 STGET 02460000 CSTPUT EQU CT3+08 STPUT 02480000 CEEVAL EQU CT3+12 EEVAL 02500000 CLOGER EQU CT3+16 LOGERR 02520000 CDCGET EQU CT3+20 DCGETR 02540000 CVCON EQU CT3+24 VCON 02560000 CTCOMT EQU CT3+36 F/8 PRINT COMMENT 02580000 CTBLDG EQU CT3+40 F/8 PRINT BUILDING 02600000 CSTROM EQU CT3+28 STROOM 02620000 F8STSC EQU CT3+20 02640000 CCONV EQU CT3+32 02660000 F8LIGN EQU CSTPUT 02680000 F8DCMP EQU CVCON 02700000 F8EXPX EQU CSTROM 02720000 ******** IO SUBROUTINE ENTRY POINT DISPLACEMENT VALUES **************** 02740000 GETPT EQU 2 (TEXTIO) 02760000 GETXTM EQU 6 (TEXTIO) 02780000 PUTXT EQU 10 (TEXTIO) 02800000 CLSTXT EQU 14 (TEXTIO) 02820000 PHCLS EQU 22 (TEXTIO) 02840000 CF7I EQU 18 (TEXTIO) 02860000 CWRESD EQU 26 (TEXTIO) 02880000 CRDESD EQU 30 (TEXTIO) 02900000 PUTXRF EQU 34 (TEXTIO) 02920000 PUTLBT EQU 38 (TEXTIO) 02940000 PUTRLD EQU 42 (TEXTIO) 02960000 GETLAT EQU 46 (TEXTIO) 02980000 WTERR EQU 50 (TEXTIO) 03000000 SYSLST EQU 54 (TEXTIO) 03020000 SYSOUT EQU 58 (TEXTIO) 03040000 CF8I EQU CF7I 03060000 EJECT 03080000 ******** CT4 DISPLACEMENT VALUES FOR POINTERS TO COMMON DATA AREAS **** 03100000 CTEXTP EQU CT4+00 FIRST BYTE OF CURRENT TEXT RECORD 03120000 CTXOFP EQU CT4+04 TEXT OPERAND FIELD LENGTH INDICATOR /TXOPNL/ 03140000 CTXABP EQU CT4+08 FIRST BYTE OF TEXT APPENDED FIXED FIELD 03160000 CTXWBP EQU CT4+12 FIRST SYMBOL WORK BUCKET IN TEXT RECORD 03180000 CTERRP EQU CT4+16 ERROR RECORD WORK AREA 03200000 CTLDCP EQU CT4+20 LITERAL DC RECORD WORK AREA 03220000 CTXWAP EQU CT4+24 TEXT RECORD WORK AREA 03240000 CTSYMP EQU CT4+28 SYMBOL TABLE 03260000 CTESDP EQU CT4+32 ESD TABLE 03280000 CTRTBP EQU CT4+36 TRANSLATE TABLE 03300000 CTESDB EQU CT4+40 ESD BASE ADDRESS 03320000 CTESRB EQU CT4+44 ESD SEGMENT RESIDENCE TABLE BASE ADDRESS 03340000 CESIOB EQU CT4+48 ESD IN-OUT AREA BASE ADDRESS 03360000 CTXIO1 EQU CT4+52 IO BUFFER 1 03380000 CTXIO2 EQU CT4+56 IO BUFFER 2 03400000 CTXIO3 EQU CT4+60 IO BUFFER 3 03420000 CTXIO4 EQU CT4+64 IO BUFFER 4 03440000 CTESRP EQU CT4+68 ESD SEGMENT RESIDENCE ENTRY POINTER 03460000 CFREEP EQU CT4+72 SYMBOL TABLE FREE STORAGE 03480000 CADJBS EQU CT4+76 ADJUSTMENT TABLE 03500000 H1STC EQU CT4+80 PAGE TITLE LINE 03520000 CTXRFP EQU CT4+84 XRF 03540000 CTRLDP EQU CT4+88 RLD 03560000 CTLBTP EQU CT4+92 LBT 03580000 CTERRB EQU CT4+96 PH8 ERROR BUFFER 03600000 CTESDS EQU CT4+100 LAST BYTE OF ESD (600 BYTE BUFFER) 03620000 CTOUT1 EQU CT4+104 PTR TO OVERFLOW FILE DCB 03640000 CTOUT2 EQU CT4+108 PTR TO ALTERNATE WORK FILE DCB 03660000 CTXUIN EQU CT4+112 PTR TO CURRENT INPUT TEXT FILE DCB 03680000 LSTDCB EQU CT4+116 PTR TO SYSLST DCB *(SYSLST) 03700000 PCHDCB EQU CT4+120 PTR TO SYSPCH DCB *(SYSPCH) 03720000 GODCB EQU CT4+124 PTR TO SYSGO DCB *(SYSGO) 03740000 EJECT 03760000 ******** CT5 DISPLACEMENT VALUES FOR CENTRAL TABLES AND ITEMS ********* 03780000 CTLOC EQU CT5+00 4 CURRENT LOCATION COUNTER 03800000 CTSEQN EQU CT5+04 4 CURRENT STATEMENT SEQUENCE NUMBER 03820000 CTLEN EQU CT5+08 4 CURRENT STATEMENT LENGTH 03840000 CTITLE EQU CT5+12 8 FIRST TITLE NAME,OPND LEN, OPND PTR 03860000 STVALU EQU CT5+20 4 VALUE FOR STPUT ENTRIES 03880000 CPRIME EQU CT5+24 4 PRIME DIVISOR FOR SYMBOL TABLE 03900000 CSTVAL EQU CT5+28 4 VALUE FROM START CARD 03920000 CTXLEN EQU CT5+32 2 TEXT BLOCK LENGTH 03940000 CNOESD EQU CT5+34 2 NUMBER OF ESDS 03960000 CENTCT EQU CT5+36 2 NUMBER OF ENTRIES 03980000 CLASID EQU CT5+38 2 LAST ID 04000000 CTNDID EQU CT5+40 2 NEXT DSECT ID 04020000 CESDNO EQU CT5+42 2 CURRENT ESD NUMBER 04040000 CSGCTR EQU CT5+44 2 ESD RESIDENT SEGMENT COUNTER 04060000 CPCNO EQU CT5+46 2 PRIVATE CODE ESD NUMBER 04080000 CCMNO EQU CT5+48 2 COMMON ESD NUMBER 04100000 STLONG EQU CT5+50 2 LENGTH ATTRIBUTE FOR STPUT ENTRIES 04120000 ESSGSZ EQU CT5+52 2 ESD SEGMENT SIZE 04140000 CESDID EQU CT5+54 1 CURRENT ESD ID 04160000 CTPCSW EQU CT5+55 1 PRIVATE CODE SWITCH 04180000 CTCMSW EQU CT5+56 1 COMMON SWITCH 04200000 CFSTID EQU CT5+57 1 FIRST CSECT ID 04220000 CTYPE EQU CT5+58 1 CURRENT CSECT TYPE 04240000 CTLIT2 EQU CT5+59 1 LTORG OR END CARD SWITCH 04260000 ESDID EQU CT5+60 1 ASSIGNED ESD ID 04280000 ADJCOD EQU CT5+61 1 ADJECTIVE CODE 04300000 CTALIN EQU CT5+62 1 ALIGNMENT CODE 0-B,1-H,3-F,7-D 04320000 CTITSW EQU CT5+64 .0 .1 ITERATION SWITCH 04340000 CTMODE EQU CT5+64 .1 .2 MODE INDICATOR 04360000 CTCLSI EQU CT5+64 .3 .1 FIRST PASS INDICATOR 04380000 CTLIT1 EQU CT5+64 .4 .1 LITERAL POOL COMPLETE DURING SUBST. 04400000 CTERRI EQU CT5+64 .5 .1 ERROR RECORD INDICATOR 04420000 CTPH7C EQU CT5+64 .6 .1 PHASE 7 COMPLETE INDICATOR 04440000 CTSYMF EQU CT5+64 .7 .1 SYMBOL TABLE FULL INDICATOR 04460000 CTPCHI EQU CT5+65 .0 .1 PUNCH OPTION INDICATOR 04480000 CTCGOI EQU CT5+65 .1 .1 CGO OPTION INDICATOR 04500000 CTITLI EQU CT5+65 .2 .1 FIRST TITLE PROCESSED INDICATOR 04520000 CTLSTI EQU CT5+65 .3 .1 LIST OPTION INDICATOR 04540000 CTGENI EQU CT5+65 .4 .1 LIST GEN OPTION INDICATOR 04560000 CTERLI EQU CT5+65 .5 .1 LIST ERROR OPTION INDICATOR 04580000 CTXRFI EQU CT5+65 .6 .1 X-REF OPTION INDICATOR 04600000 CTCNT0 EQU CT5+65 .7 .1 OPTION BYTE 0 INDICATOR I000 04620020 CTSDVI EQU CT5+66 .0 .1 SELF DEFINING VALUE INDICATOR 04640000 CTLCRI EQU CT5+66 .1 .1 LOCATION COUNTER REFERENCE INDICATOR 04660000 CTPDSI EQU CT5+66 .2 .1 DEFINED SYMBOLS REQ. FOR F/7 EEVAL 04680000 CTDORCI EQU CT5+66 .3 .1 CURRENTLY IN DSECT OR COM IND. 04700000 CTSCON EQU CT5+66 .4 .2 ADDRES ERROR IN S-CON A39647 04701021 CTEXENSW EQU CT5+66 .5 .1 ENTRY-EXTRN EQU-D SWITCH A32954 04702020 CTSWXT EQU CT5+66 .6 .1 EXTRN-WXTRN MODE SWITCH I004 04705020 CTLIT3 EQU CT5+66 .7 .1 TELL IF LITS ARE GEN'D A27005 04710019 CTSEVCOD EQU CT5+67 1 HIGHEST SEVERITY CODE(MNOTE/ERROR) 04720000 CTDDERR EQU CT5+68 .0 .1 GO DD MISSING I000 04722020 CTDDERP EQU CT5+68 .1 .1 PUNCH DD MISSING I000 04724020 CTDDERT EQU CT5+68 .2 .1 TERM DD MISSING I000 04726020 CTTSTI EQU CT5+69 .0 .1 TESTRAN OPTION INDICATOR I000 04728020 CTTRMI EQU CT5+69 .1 .1 TERM OPTION INDICATOR I000 04730020 CTNUMI EQU CT5+69 .2 .1 LINE NUMBER INDICATOR I000 04732020 CTSTMI EQU CT5+69 .3 .1 STATEMENT NUMBER INDICATOR I000 04734020 CTCNT1 EQU CT5+69 .7 .1 OPTION BYTE1 INDICATOR I000 04736020 CBDNO EQU CT5+70 2 BLANK DSECT ESD NO 04740000 CBDSW EQU CT5+72 1 BLANK DSECT ID NO 04760000 CTPGLNCT EQU CT5+73 1 PAGE LINE COUNT 04780000 CTMRSRTN EQU CT5+76 4 MRS RETURN 04800000 CTZERO EQU CT5+96 8 TWO FULL WORDS OF ZEROES 04820000 CTWORK EQU CT5+104 256 256 BYTE WORK AREA 04840000 CTONWP EQU CT5+360 8 NEXT WRITE POINTER ON OVF1 04860000 CTRXRF EQU CT5+368 4 FIRST XRF BLOCK PTR ON OVF1 04880000 CTRLBT EQU CT5+372 4 FIRST LBT BLOCK PTR ON OVF1 04900000 CTRRLD EQU CT5+376 4 FIRST RLD BLOCK PTR ON OVF1 04920000 CTRERR EQU CT5+380 4 FIRST ERROR BLOCK (PH8) 04940000 CTCXRF EQU CT5+384 2 XRF BLOCK COUNT 04960000 CTCLBT EQU CT5+386 2 LBT BLOCK COUNT 04980000 CTCRLD EQU CT5+388 2 RLD BLOCK COUNT 05000000 CTCERR EQU CT5+390 2 ERROR BLOCK COUNT (PH8) 05020000 CTCLAT EQU CT5+392 2 LAT BLOCK COUNT ON OVF2 05040000 CTLALN EQU CT5+394 2 LAT LENGTH INDICATOR 05060000 CTLITA EQU CT5+400 16 CURRENT LITERAL POOL STRING LENGTHS 05080000 CTLITB EQU CT5+416 16 CURRENT LITERAL POOL STRING COUNTS 05100000 CTXSAV EQU CT5+432 8 05120000 CTFSTN EQU CT5+440 8 FIRST CSECT NAME 05140000 CTDATE EQU CT5+448 8 DATE FOR LISTING 05160000 CTLINECT EQU CT5+456 4 PRINT LINE COUNT 1 OF 2 05180000 CTPBUFPT EQU CT5+460 4 PRINT BUFFER POINTER 2 OF 2 05200000 CADJTB EQU CT5+464 ADJUSTMENT TABLE BASE 05220000 RR2SWH EQU CT5+468 RR2 INSTRUCTION TYPE SWITCH 05240000 ERSWH EQU CT5+472 ERROR SWITCH 05260000 CESDIDPS EQU CT5+473 PSEUDO CURRENT ESD ID 05280000 CTEMERR EQU CT5+474 MNOTE ERRROR INDICATOR 05300000 SPACSW EQU CT5+476 SPACE SWITCH 05320000 EJCTSW EQU CT5+480 EJECT SWITCH 05340000 REPSW EQU CT5+484 REPO SWITCH 05360000 CCRDCT EQU CT5+488 CARD COUNT 05380000 CTLATL EQU CT5+492 LITERAL ADJ TAB - LAST BYTE + 1 05400000 ENDSWH EQU CT5+496 END SWITCH 05420000 F8OPRN EQU CT5+500 OPERAND POINTER 05440000 CTLATB EQU CT5+504 05460000 F8CADJ EQU CT5+508 CURRENT ADJUSTMENT 05480000 ALIGN4 EQU CT5+512 FOR ALIGNING 05500000 F8ALLB EQU CT5+516 FULL WORD OF BITS 05520000 F83BYT EQU CT5+520 3 BYTS OF BITS, LOW ORDER 05540000 F82BYT EQU CT5+524 2 BYTES OF BITS, LOW ORDER 05560000 F81BYT EQU CT5+528 1 BYTE OF BITS, LOW ORDER 05580000 F8PON EQU CT5+532 05600000 F8PGEN EQU CT5+536 05620000 F8PDAT EQU CT5+540 05640000 F8ZERO EQU CT5+544 ONE FULL WORD OF ZERO 05660000 F8INST00 EQU CT5+548 05680000 F8INST EQU CT5+549 16 DEEP INSTRUCTION BLDG AREA 05700000 F8ZRO EQU CT5+568 ONE FULL WORD OF ZWRO 05720000 PYRSW EQU CT5+572 05740000 F8YDC EQU CT5+576 05760000 CTESRN EQU CT5+580 ESD SEG COUNT 05780000 CTWRAP7 EQU CT5+584 SEQ FOR WRAPAROUND 05800000 CTSEQ8 EQU CT5+588 SEQ FOR WRAP AROUND CHECK 05820000 CTRENT EQU CT5+592 REENTRANT ERROR FLAG 05840000 CTF8LNGT EQU CT5+596 STATEMENT LENGTH FOR WRAP AROU 05860000 CTWRAPX EQU CT5+600 05880000 TERMNAM EQU CT5+604 8 SAVED DD NAME FOR SYSTERM I000 05890020 LISTNAM EQU CT5+612 SAVED DD NAME FOR SYSPRINT I000 05895020 CTIDR EQU CT5+620 1 IDR SWITCH 40=NO,F1=ONE,F2=TWO IDR ITEMS 21016 05897021 CT2IDR EQU CT5+621 19 SECOND IDR IF PRESENT 21016 05899021 F8WORK EQU CT6 05900000 EJECT 05920000 ******** DIMENSIONING FOR INTERNAL TEXT RECORDS *********************** 05940000 * FIXED FIELD 05960000 TXRL EQU 0 .0 2.0 RECORD LENGTH 05980000 TXLRI EQU 2 .0 .1 LAST RECORD IN BUFFER INDICATOR 06000000 TXRT EQU 2 .1 .3 RECORD TYPE 06020000 TXBF EQU 2 .4 .1 BREAK FLAG 06040000 TXERI EQU 2 .5 .1 ERROR RECORD FOLLOWS INDICATOR 06060000 TXESI EQU 2 .6 .1 EQUAL SIGN INDICATOR 06080000 TXMARK EQU 2 .7 .1 PHASE 7 ITERATION POINT FLAG 06100000 TXTO EQU 3 .0 .2 TYPE OF OPERATION 06120000 TXEMF EQU 3 .2 .1 EXTENDED MNEMONIC FLAG 06140000 TXMDN EQU 3 .3 .1 MULTIPLY DEFINED NAME INDICATOR 06160000 TXR1M EQU 3 .4 .4 R1 MASK FOR EXTENDED MNEMONICS 06180000 TXHEX EQU 4 .0 1.0 MACHINE OP CODE OR ASSEMBLER CODE 06200000 TXASC EQU 5 .0 1.0 ASSEMBLER SWITCH CODE 06220000 TXABP EQU 6 .0 2.0 APPENDED FIXED FIELD POINTER 06240000 * VARIABLE FIELD 06260000 TXNAML EQU 8 .0 1.0 NAME FIELD LENGTH 06280000 TXNAME EQU 9 .0 V.0 NAME FIELD 06300000 TXOPL EQU 0 .0 1.0 OPERATION FIELD LENGTH 06320000 TXOP EQU 1 .0 V.0 OPERATION FIELD 06340000 TXOPNL EQU 0 .0 1.0 OPERAND FIELD LENGTH 06360000 TXOPN EQU 1 .0 V.0 OPERAND FIELD 06380000 TXCOML EQU 0 .0 1.0 COMMENTS FIELD LENGTH 06400000 TXCOM EQU 1 .0 V.0 COMMENTS FIELD 06420000 * APPENDED FIXED FIELD 06440000 TXLOC EQU 0 .0 3.0 LOCATION COUNTER 06460000 TXURS EQU 3 .0 1.0 UNRESOLVED SYMBOL COUNTER 06480000 TXLES EQU 4 .4 .1 END OF STRING INDICATOR 06500000 TXSTG EQU 4 .5 .3 STRING NUMBER 06520000 TXALIN EQU 4 .5 .3 ALIGNMENT FOR MACHINE OPS 06540000 TXFAFL EQU 5 LENGTH OF FIXED APPENDED FIELD 06560000 * WORK BUCKET TYPE 1 - LITERAL IN OPERAND FIELD 06580000 *ZERO EQU 5 .0 .2 FIRST TWO BITS MUXT BE ZERO 06600000 TXLSOP EQU 5 .4 .1 LITERAL IN SECOND OPERAND A52831 06602021 TXLXRI EQU 5 .5 .1 LITERAL XREF INDICATOR A28596 06610020 TXLEVI EQU 5 .6 .1 LITERAL EVALUATED INDICATOR 06620000 TXLASI EQU 5 .7 .1 LITERAL ASSIGNED INDICATOR 06640000 TXLSTG EQU 6 .0 1 LITERAL STRING NUMBER 06660000 TXLDSP EQU 7 .0 3 LITERAL STRING DISPLACEMENT 06680000 TXLLEN EQU 10 1 LITERAL LENGTH ATTRIBUTE 06700000 * WORK BUCKET TYPE 2 - 6 BYPE SYMBOL W.B. 06720000 TXWTYP EQU 0 .0 .1 WORK BUCKET TYPE 1-TYPE 2, 0-TYPE 1 OR 3 06740000 TXWLEN EQU 0 .1 .1 WORK BUCKET LENGTH 1- 15BYTES, 0- 6 BYTE 06760000 TXSDOC EQU 0 .2 .1 SYMBOL DEFINED IN DSECT OR COM INDICATOR 06780000 TXSUBS EQU 0 .3 .1 VALUE SUBSTITUDED INDICATOR 06800000 TXSLAS EQU 0 .4 .1 LAST SYMBOL IN OPERAND INDICATOR 06820000 TXSEXI EQU 0 .5 .1 IMPLIED LENGTH EXCEEDS 256 INDICATOR 06840000 TXSTPC EQU 0 .6 .2 TO BE DEFINED BY B. BITTNER 06860000 TXSLEN EQU 1 1 IMPLIED LENGTH 06880000 TXSESD EQU 2 1 ESD ID 06900000 TXSVAL EQU 3 3 VALUE 06920000 TXSBLN EQU 4 1 SYMBOL BYTE LENGTH 06940000 TXSESL EQU 4 .0 .1 LAST OPERAND IN EXTRN/ENTRY INDICATOR 06960000 TXSPTR EQU 5 1 POINTER TO SYMBOL IN OPERAND FIELD 06980000 * WORK BUCKET TYPE 3 - 15 BYTE DC, DS, LDC W.B. 07000000 *TXWTYP EQU 0 .0 .1 WORK BUCKET TYPE 1-TYPE 2, 0-TYPE 1 OR 3 07020000 *TXWLEN EQU 0 .1 .1 WORK BUCKET LENGTH 1-15 BYTES, 0-6 BYTES 07040000 TXDPPI EQU 0 .2 .1 DC PREVIOUSLY PROCESSED INDICATOR 07060000 TXDLMP EQU 0 .3 .1 LENGTH MODIFIER PRESENT INDICATOR 07080000 TXDTYP EQU 1 1 TYPE - TRANSLATED 07100000 TXDLEN EQU 2 3 TOTAL LENGTH 07120000 TXDLAS EQU 0 .4 .1 LAST OPERAND INDICATOR 07140000 TXDUPL EQU 5 3 DUPLICATION FACTOR 07160000 TXDCON EQU 8 1 NUMBER OF CONSTANTS 07180000 TXDPTR EQU 9 1 POINTER TO FIRST BYTE OF OPERAND 07200000 TXDEXP EQU 10 1 EXPONENT 07220000 TXDSCM EQU 11 1.3 SCALE MODIFIER 07240000 TXDSYM EQU 12 .3 .1 SYMBOL WORK BUCKETS FLAG 07260000 TXDALN EQU 12 .4 .3 ALIGNMENT 07280000 TXDLMD EQU 12 .7 .1 LENGTH MODIFIER TYPE 1-BIT, 0-BYTE 07300000 TXDLNM EQU 13 2 LENGTH MODIFIER VALUE 07320000 SPACE 10 07340000 *CHANNEL COMMAND CODES FOR RECFM=XM CARRIAGE CONTROL(1443/1403) 07360000 SPACE 07380000 EJECTAP EQU X'89' EJECT(CHANNEL 1) AFTER PRINT 07400000 SPACE1AP EQU X'09' SPACE 1 AFTER PRINT(NORMAL) 07420000 SPACE2AP EQU X'11' SPACE 2 AFTER PRINT 07440000 SPACE3AP EQU X'19' SPACE 3 AFTER PRINT 07460000 SPACE1IM EQU X'0B' SPACE 1 IMMEDIATE(NO PRINT) 07480000 SPACE2IM EQU X'13' SPACE 2 IMMEDIATE 07500000 SPACE3IM EQU X'1B' SPACE 3 IMMEDIATE 07520000 MEND 07540000 ./ ADD SSI=01013522,SOURCE=1,NAME=FMTPTRN MACRO 01000020 &NAME FMTPTRN &CODE,&LN1,&LN2,&OFFS1,&OFFS2,&LPTR,&DPTR,&LAST 02000020 LCLA &A,&B 03000020 &NAME DS 0F TO ALIGN TO WORD BOUNDRY 04000020 AIF (N'&CODE EQ 1).CODE1 05000020 AIF (N'&CODE EQ 2).CODE2 06000020 AIF (N'&CODE EQ 3).CODE3 07000020 AIF (N'&CODE EQ 4).CODE4 08000020 AIF (N'&CODE EQ 5).CODE5 09000020 DC AL1(&CODE(1)+&CODE(2)+&CODE(3)+&CODE(4)+&CODE(5)+&CODE(6X10000020 )) CODE BYTE 11000020 AGO .LN 12000020 .CODE1 DC AL1(&CODE(1)) CODE BYTE 13000020 AGO .LN 14000020 .CODE2 DC AL1(&CODE(1)+&CODE(2)) CODE BYTE 15000020 AGO .LN 16000020 .CODE3 DC AL1(&CODE(1)+&CODE(2)+&CODE(3)) CODE BYTE 17000020 AGO .LN 18000020 .CODE4 DC AL1(&CODE(1)+&CODE(2)+&CODE(3)+&CODE(4)) CODE BYTE 19000020 AGO .LN 20000020 .CODE5 DC AL1(&CODE(1)+&CODE(2)+&CODE(3)+&CODE(4)+&CODE(5)) X21000020 CODE BYTE 22000020 .LN AIF (T'&LN1 EQ 'O').NOLN1 23000020 AIF (&LN1 EQ 0).NOLN1 24000020 AIF (T'&LN2 EQ 'O').NOLN2 25000020 AIF (&LN2 EQ 0).NOLN2 26000020 DC AL1(&LN1*16+&LN2-17) LENGTHS FOR LABEL AND DATA 27000020 AGO .OFF 28000020 .NOLN1 AIF (T'&LN2 EQ 'O').NOLN 29000020 AIF (&LN2 EQ 0).NOLN 30000020 DC AL1(&LN2-1) LENGTH OF DATA 31000020 AGO .OFF 32000020 .NOLN2 DC AL1(&LN1*16-16) LENGTH OF LABEL 33000020 AGO .OFF 34000020 .NOLN DC AL1(0) NO LABEL OR DATA LENGTHS 35000020 .OFF AIF (T'&OFFS1 EQ 'O').NOOFF1 36000020 AIF (T'&OFFS2 EQ 'O').NOOFF2 37000020 DC AL1(&OFFS1,&OFFS2) LABEL AND DATA OFFSETS INTO LINE 38000020 AGO .PTRS 39000020 .NOOFF1 AIF (T'&OFFS2 EQ 'O').NOOFFS 40000020 DC AL1(0,&OFFS2) OFFSET FOR DATA INTO LINE 41000020 AGO .PTRS 42000020 .NOOFF2 DC AL1(&OFFS1,0) OFFSET OF LABEL INTO LINE 43000020 AGO .PTRS 44000020 .NOOFFS DC AL1(0,0) NO LABEL OR DATA OFFSETS 45000020 .PTRS AIF (T'&LPTR EQ 'O').DPTR NO LABEL PTR IF OMMITED 46000020 AIF (N'&LPTR GT 1).LPTR2 FIRST VAL IS LABEL FOR PTR 47000020 DC A(&LPTR(1)) ADDR OF LABEL 48000020 AGO .DPTR 49000020 .LPTR2 ANOP 50000020 &LPTR(1) DC A(&LPTR(2)) ADDR OF LABEL 51000020 .DPTR AIF (T'&DPTR EQ 'O').END NO DATA PTR IF OMITTED 52000020 AIF (N'&DPTR GT 1).DPTR2 FIRST VAL IS LABEL FOR PTR 53000020 DC A(&DPTR(1)) ADDR OF DATA 54000020 AGO .END 55000020 .DPTR2 ANOP 56000020 &DPTR(1) DC A(&DPTR(2)) ADDR OF DATA 57000020 .END AIF (T'&LAST EQ 'O').ENDA 58000020 AIF ('&LAST' NE 'LAST').ENDA 59000020 DC AL1(0) TO END PATTERN 60000020 .ENDA MEND 61000020 ./ ADD SSI=01012934,SOURCE=1,NAME=FREEJSCB MACRO 06000019 &MACNAME FREEJSCB &SYSTEM=MVT 12000019 &MACNAME LA 15,JSCBDISP - LOAD DISPLACEMENT OF FIRST BYTE IN JSCB 18000019 AR 1,15 - COMPUTE ADDRESS OF BYTES TO BE FREED 24000019 AIF ('&SYSTEM' EQ 'MVT').FREEMVT 30000019 AIF ('&SYSTEM' EQ 'MFT').FREEMFT 36000019 MNOTE ,'ONLY MFT OR MVT VALID AS SYSTEM PARAMETERS' 42000019 MEXIT 48000019 .FREEMFT ANOP 54000019 FREEMAIN R,LV=JSCBMFTL,A=(1),SP=255 60000019 MEXIT 66000019 .FREEMVT ANOP 72000019 FREEMAIN R,LV=JSCBMVTL,A=(1),SP=253 78000019 MEXIT 84000019 MEND 90000019 ./ ADD SSI=00015211,SOURCE=1,NAME=FSACONV * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00020000 * * 00040000 * TYPE CONVERSION ROUTINES * 00060000 * * 00080000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00100000 SPACE 3 00120000 * THESE ROUTINES PERFORM CONVERSION BETWEEN INTEGER AND REAL 00140000 * TYPE FOR EITHER SINGLE OR DOUBLE PRECISION. 00160000 SPACE 00180000 * CALLING SEQUENCES.. 00200000 SPACE 00220000 * REAL TO INTEGER CONVERSION 00240000 * BAL ADR,CNVRDI(FSA) REAL NUMBER IN F.P. REG. 0 00260000 * --- RETURN WITH INTEGER IN REG STH 00280000 SPACE 00300000 * INTEGER TO REAL CONVERSION 00320000 * BAL ADR,CNVIRD(FSA) INTEGER NUMBER IN REG. STH 00340000 * --- RETURN WITH REAL NR IN FP REG 0 00360000 SPACE 00380000 * ALGOL ENTIER FUNCTION 00400000 * BAL ADR,ENTIER(FSA) REAL NUMBER IN F.P. REG. 0 00420000 * --- RETURN WITH INTEGER IN REG STH 00440000 SPACE 00460000 ******** INTEGER TO REAL CONVERSION 00480000 SPACE 00500000 USING FSAREA,FSA 00520000 CONVIR EQU * 00540000 CNVIRD EQU *-FSAREA 00560000 X STH,CNVCNST1+4 00580000 ST STH,CNVBUF1+4 00600000 LD FPR0,CNVBUF1 00620000 SD FPR0,CNVCNST1 00640000 CNVINST EQU * *** 00660000 STD FPR0,CNVBUF2 * 00680000 MVC CNVBUF2+1(3),CNVCNST1+1 * 00700000 AD FPR0,CNVBUF2 * 00720000 BR ADR * 00740000 * * FOR LONG PRECISION, THESE 00760000 ******** REAL TO INTEGER CONVERSION * ARE REPLACED AT EXECUTION 00780000 * * TIME BY THE INSTRUCTIONS 00800000 * * AT CNVINSTD 00820000 ENTIER EQU *-FSAREA * 00840000 STE FPR0,CNVBUF3 * 00860000 LD FPR0,CNVBUF3 * 00880000 B ENTIER1 * 00900000 CNVRDI EQU *-FSAREA * 00920000 STE FPR0,CNVBUF3 * 00940000 LD FPR0,CNVBUF3 * 00960000 * *** 00980000 AD FPR0,CNVCNST2 01000000 ENTIER1 STD FPR0,CNVBUF4 01020000 CE FPR0,CNVCNST3 01040000 BNL ERROR40(FSA) 01060000 AW FPR0,CNVCNST1 01080000 BP LABEL1 01100000 CLC CNVBUF4(8),CNVCNST4 01120000 BH ERROR40(FSA) 01140000 LABEL1 STD FPR0,CNVBUF2 01160000 L STH,CNVBUF2+4 01180000 X STH,CNVCNST1+4 01200000 SD FPR0,CNVCNST1 01220000 CD FPR0,CNVBUF4 01240000 BCR 13,ADR 01260000 BCTR STH,ADR 01280000 DS 0D 01300000 CNVBUF1 DC X'4E00000000000000' 01320000 CNVBUF2 DS 1D 01340000 CNVBUF3 DC X'0000000000000000' 01360000 CNVBUF4 DS 1D 01380000 CNVCNST1 DC X'4E00000080000000' 01400000 CNVCNST2 DC X'4080000000000000' 01420000 CNVCNST4 DC X'C880000000000000' 01440000 CNVCNST3 DC X'48800000' 01460000 SPACE 01480000 DS 0F 01500000 SPACE 01520000 * DISPLACEMENTS FOR CERTAIN ERROR EXITS IN FSA 01540000 SPACE 01560000 OUTOFB EQU FSAERR+4*16 01580000 NUMBIND EQU FSAERR+4*19 01600000 ARRAYBD EQU FSAERR+4*15 01620000 ERROR40 EQU FSAERR+4*40 01640000 OERR22 EQU FSAERR+4*22 01660000 ENDLESL EQU FSAERR+4*17 01680000 OERR21 EQU FSAERR+4*21 01700000 SPACE 01720000 * END OF SYMLIB PART OF FIXED STORAGE AREA 01740000 SPACE 01760000 SPACE 01780000 ./ ADD SSI=01013390,SOURCE=1,NAME=FSAREA *0011021800 0226 00010015 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00020000 * * 00040000 * C O M M O N D A T A A R E A * 00060000 * * 00080000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00100000 SPACE 3 00120000 * THE FOLLOWING BLOCK OF STORAGE CONTAINS DATA THAT IS 00140000 * IMMEDIATELY ACCESSIBLE TO ALL OTHER MODULES DURING THE EXECUTION. 00160000 * IT IS ADDRESSED BY MEANS OF REG. 13 OR (FOR THE LIBRARY 00180000 * SUBROUTINES) BY REG. 12. 00200000 SPACE 00220000 FSAREA EQU * 00240000 * SAVE AREAS 00260000 SPACE 00280000 DS 18F STANDARD SAVE AREA 00300000 ASAVE EQU *-FSAREA ALTERNATE SAVE AREA USED BY 00320000 DS 18F CERTAIN SUBROUTINES 00340000 SPACE 00360000 * MISCELLANEOUS WORK AREAS AND CONSTANTS 00380000 SPACE 00400000 FCTVALST EQU *-FSAREA TEMPORARY STORAGE FOR 00420000 DS 1D FUNCTION VALUES 00440000 ASTLOC EQU *-FSAREA DISPL.FOR ADDR.OF STAND.LOCTN. 00460000 DC A(FSAREA+FCTVALST) 00480000 BRRST EQU *-FSAREA TEMPORARY SAVE REG. BRR 00500000 HW EQU BRRST TEMPORARY HALFWORD STORAGE 00520000 DS 1F 00540000 PROLREG EQU *-FSAREA STORAGE FOR PBT AND LAT WHEN 00560000 DS 2A *A PROCEDURE IS FORMAL PARAM. 00580000 * HALFWORD CONTAINING PBN OF CALLED BLOCK IN SECOND BYTE 00600000 DS 0H 00620000 DC X'00' 00640000 PROLPBN EQU *-FSAREA STORAGE FOR CALLED PBN 00660000 DC X'00' 00680000 EIGHT EQU *-FSAREA CONST.FOR REDUCING RAS. 00700000 DC H'8' 00720000 SPACE 00740000 DS 0F 00760000 ADSTAB EQU *-FSAREA ADDRESS OF DSTABLE 00780000 DS A IN THE OBJECT PROGRAM 00800000 ANOTTAB EQU *-FSAREA ADDRESS OF NOTE TABLE 00820000 DS A (INSERTED BY THE OPEN ROUT.) 00840000 SPACE 00860000 IHIFSAST EQU * 00880000 PGOPSW EQU *-FSAREA PROGRAM CHECK OLD PSW 00900000 DS 2F 00920000 FSAPICA EQU *-FSAREA OLD PICA ADDRESS 00940000 DC F'0' 00960000 SCRCS EQU *-FSAREA SEMICOLON NUMBER 00980000 DS 1H 01000000 DTSW EQU *-FSAREA OPTION SWITCHES 01020000 OPTSW EQU DTSW 01040000 DC X'00' DUMP-80,TRACE-40,SHORT-20 01060000 FSAERCOD EQU *-FSAREA ERROR CODE FOR ERROR ROUTINE 01080000 DS C 01100000 SPACE 01120000 * RETURN ADDRESS STACK POINTERS DO NOT CHANGE ORDER 01140000 SPACE 01160000 DS 0F 01180000 IHIFSARS EQU * 01200000 RASSTART EQU *-FSAREA ADDRESS OF FIRST ENTRY IN RAS-8 01220000 DS F 01240000 RASPT EQU *-FSAREA RAS-POINTER FROM TOP 01260000 DS F 01280000 RASEND EQU *-FSAREA ADDRESS OF LAST ENTRY IN RAS+8 01300000 DS F 01320000 RASPB EQU *-FSAREA RAS-POINTER FROM BOTTOM 01340000 DS F 01360000 SPACE 01380000 * LIST OF BRANCH INSTRUCTIONS TO COMMONLY USED SUBROUTINES 01400000 SPACE 01420000 BRLIST DS 0F 01440000 CAP1 EQU *-FSAREA FIRST PART CAPS 01460000 NOP 0 01480000 CAP2 EQU *-FSAREA SECOND PART CAPS 01500000 NOP 0 01520000 PROLOGP EQU *-FSAREA PROLOGUE FORMAL PARAMETER ENTRY 01540000 PROLOGFP EQU PROLOGP 01560000 NOP 0 01580000 PROLOG EQU *-FSAREA PROLOGUE PROGRAM USUAL ENTRY 01600000 NOP 0 01620000 RETPROG EQU *-FSAREA DISPLACEMENT-RETURN-PROGRAM 01640000 NOP 0 01660000 EPILOGP EQU *-FSAREA EPILOGUE PROGRAM,PROCEDURE ENTRY 01680000 NOP 0 01700000 EPILOGB EQU *-FSAREA EPILOGE PROGRAM,BETA-BLOCK ENTRY 01720000 NOP 0 01740000 EPILPR3 EQU *-FSAREA EPILOGUE PROGRAM ENTRY 3 01760000 NOP 0 01780000 CSWE1 EQU *-FSAREA FIRST PART CSWES 01800000 NOP 0 01820000 CSWE2 EQU *-FSAREA SECOND PART CSWES 01840000 NOP 0 01860000 LOADPP EQU *-FSAREA LOAD PRECOMPILED PROCEDURE ROUTINE 01880000 NOP 0 01900000 TRACE EQU *-FSAREA 01920000 MVC 0(0),0 01940000 NOP 0 01960000 NOP 0 01980000 TERMNTE EQU *-FSAREA NORMAL TERMINATION EXIT 02000000 NOP 0 02020000 BCR EQU *-FSAREA 02040000 BCR 0,0 VARIABLE CONDITIONAL BRANCH 02060000 GETMSTO EQU *-FSAREA 02080000 NOP 0 02100000 SPACE 02120000 VALUCALL EQU *-FSAREA 02140000 NOP 0 02160000 IORLST EQU *-FSAREA 0226 02170015 NOP 0 0226 02180015 SPACE 02200000 FSAERR EQU X'1CC' DISPL. FOR ERROR LIST 02220000 ./ ADD SSI=41030028,NAME=GBLGENER,SOURCE=0 MACRO 00020021 &NAME GBLGENER &C=,&D=,&U1=,&U=,&MIN1=21,&MIN2=51,&TSO=YES 00040020 .* &C = NUMBER OF CONTROL UNITS SUPPORTED 00060000 .* &D = NUMBER OF DEVICES SUPPORTED 00080000 .* &U1 = NUMBER OF ADDRESSES FOR UNIT NAMES 00100000 .* &U = NUMBER OF UNIT NAMES 00120000 .* &MIN1 = NUMBER OF LINKLIB USER ROUTINES+1 00126018 .* &MIN2 = NUMBER OF SVCLIB USER ROUTINES+1 00132018 .* &TSO = TSO SWITCH - 'NO' EXCLUDES TSO GLOBALS 00136020 REPRO 00140000 GBLA &SGTESTA(2),&HEX,&SGCTRLA(2),&SGFORTA(8),&SGSUPRA(2) 00160020 PUNCH ' GBLA &&SGUNNMA(&U1),&&SGCNTRA(10),&&SGDADRA(&D),&&SGCBLEA(2)' 00180000 PUNCH ' GBLA &&SGCPRGA(23),&&SGOPCHA,&&SGDASDA,&&SGACTR' S21167 00200000 REPRO 00220000 GBLA &IEALOA,&IEAHIA,&IEALMTA,&SGPL11A(10),&SGSTMGA,&SGMAXDV 00240000 REPRO 00260000 GBLA &SGCBLFA(3),&SGMAXA(3),&SGFORLA(5),&SGCBLUA(3) 00280018 REPRO 00300000 GBLA &SGSCHDA(20),&SGUTSZA,&SGALGOA(1),&SG2314A,&SG5450A,&SGSCNYA(2) 00320021 REPRO 00322021 GBLA &SGSCHAA(12),&SGSCNPA(31),&SGAR01A(31),&SGAR02A(31),&SGAR03A(31) 00324021 REPRO 00324421 GBLA &SGAR04A(31),&SGAR05A(31),&SGAR06A(31),&SGAR07A(31),&SGAR08A(31) 00324821 REPRO 00325221 GBLA &SGAR09A(31),&SGAR10A(31),&SGAR11A(31),&SGAR12A(31) 00325621 REPRO 00326020 GBLA &SG3330A,&SG2305A,&SGTGRIA(32),&SGTGROA(32) 00332021 REPRO 00334021 GBLA &SG3505A,&SG3525A 00336021 REPRO 00340000 GBLA &SGCKPA(6),&SG2321A,&SG2311A,&SGLDRA,&SGCPRNA(1),&SGBSCA 00360019 REPRO 00390017 GBLA &SGCPRPA(104),&SGLINKA(8),&SGSCNXA,&SGSCNZA 00400017 PUNCH ' GBLA &&SGDNBFA(&D),&&SGDEVTP(&D),&&SGETABA(&D)' 00420000 PUNCH ' GBLA &&SGCUN1A(&C)' 00440000 PUNCH ' GBLA &&SGGJUA(15),&&SGGJCA(11) ' 00446015 .* * * TEST FOR TSO - SGMINPAK WON'T CONTAIN TSO GLOBALS -- GBLA'S * 00447020 AIF ('&TSO' EQ 'NO').A5 TEST FOR TSO - BRANCH IF NO 00448020 REPRO 00449020 GBLA &SGEDITA(25),&SGTSOPA(4),&SGMODA(1),&SGEDT2A(25),&SGEDT3A(25) 00449421 REPRO 00449921 GBLA &SGEDT4A(25),&SGEDT5A(25) 00453221 .A5 ANOP 00460121 PUNCH ' GBLB &&SGGJCB(8),&&SGLDRB(5)' 00463421 REPRO 00466721 GBLB &SGCHANB(240),&SGQUITB,&SGMENTB(89),&SGSUPRB(48),&SGCPRGB(14) 00470000 PUNCH ' GBLB &&SGUNU1B(&C),&&SGUNU2B(&C),&&SGUNU3B(&C),&&SGUNU4B(&C)' 00490018 PUNCH ' GBLB &&SGUNU5B(&C),&&SGUNU6B(&C),&&SGUNU7B(&C),&&SGUNU8B(&C)' 00500018 PUNCH ' GBLB &&SGUNM1B(&C),&&SGUNM2B(&C),&&SGUNM3B(&C),&&SGUNM4B(&C)' 00510018 PUNCH ' GBLB &&SGUNM6B(&C),&&SGUNF4B(&C),&&SGUNF5B(&C),&&SGUNT3B(&C)' 00540015 PUNCH ' GBLB &&SGUNF6B(&C)' 00550018 PUNCH ' GBLB &&SGUNF1B(&C),&&SGUNF2B(&C),&&SGUNF3B(&C),&&SGUNM5B(&C)' 00610016 PUNCH ' GBLB &&SGUNT1B(&C),&&SGUNT2B(&C),&&SGTESTB(6)' 00640018 REPRO 00680000 GBLB &SGSCHDB(44),&SGDMGTB(5),&SGCPUB(54),&SGSTMGB(17),&SGDCLSB(83) 00690021 REPRO 00700021 GBLB &SGUCSIB(12),&SGUCSDB(12),&SGCKPB(56),&SGCBLUB(24) 00710017 REPRO 00713020 GBLB &SGUCSEB(2),&SG2CSIB(5),&SG2CSDB(5) 00716020 PUNCH ' GBLB &&SGDT01B(&D),&&SGDT02B(&D),&&SGDT03B(&D),&&SGDT04B(&D),&X00720000 &LIMIT(4)' 00740017 PUNCH ' GBLB &&SGDT05B(&D),&&SGDT06B(&D),&&SGDT07B(&D),&&SGDT08B(&D)' 00760000 PUNCH ' GBLB &&SGDT12B(&D),&&SG3410B(&D)' 00770021 PUNCH ' GBLB &&SGBRSTB(16)' 00780020 PUNCH ' GBLB &&SGDU01B(&D),&&SGDU02B(&D),&&SGDU03B(&D),&&SGDU04B(&D)' 00800000 PUNCH ' GBLB &&SGDU05B(&D),&&SGDU06B(&D),&&SGDU07B(&D),&&SGDU08B(&D)' 00820000 PUNCH ' GBLB &&SGDU09B(&D),&&SGDU10B(&D),&&SGDU11B(&D)' 00830000 PUNCH ' GBLB &&SGDM01B(&D),&&SGDM02B(&D),&&SGDM03B(&D),&&SGDM04B(&D)' 00840000 PUNCH ' GBLB &&SGDM05B(&D),&&SGDM06B(&D),&&SGDM07B(&D),&&SGDM08B(&D)' 00850017 PUNCH ' GBLB &&SGDM09B(&D),&&SGOPSUB(&D),&&SG2321B(&D),&&SGDASWB(&D)' 00860018 PUNCH ' GBLB &&SGDF01B(&D),&&SGDF02B(&D),&&SGDF03B(&D),&&SGDF04B(&D)' 00880000 PUNCH ' GBLB &&SGDF05B(&D),&&SGDF06B(&D),&&SGDF07B(&D),&&SGDF08B(&D)' 00900000 PUNCH ' GBLB &&SGDF09B(&D),&&SGDF10B(&D),&&SGDF11B(&D),&&SGDF12B(&D)' 00920021 PUNCH ' GBLB &&SGDF13B(&D),&&SGDF14B(&D),&&SGDF15B(&D)' 00930021 PUNCH ' GBLB &&SGDAP1B(&D),&&SGDAP2B(&D),&&SGDAP3B(&D)' 00932021 PUNCH ' GBLB &&SGDAP4B(&D),&&SGDAP5B(&D),&&SGDAP6B(&D),&&SGDRQ1B(&D)' 00940000 PUNCH ' GBLB &&SGDAP7B(&D),&&SGDAP8B(&D),&&SGDAP9B(&D),&&SGDAPAB(&D)' 00942020 PUNCH ' GBLB &&SGDAPBB(&D),&&SGDAPCB(&D),&&SGDAPDB(&D),&&SGDAPEB(&D)' 00944020 PUNCH ' GBLB &&SGDAPFB(&D)' 00946020 PUNCH ' GBLB &&SGDRQ2B(&D)' 00950017 PUNCH ' GBLB &&SGDAD1B(&D),&&SGDAD2B(&D),&&SGDAD3B(&D),&&SGDAD4B(&D)' 00960000 PUNCH ' GBLB &&SGDAD5B(&D),&&SGDAD6B(&D),&&SGDAD7B(&D),&&SGDAD8B(&D)' 00980016 PUNCH ' GBLB &&SGDSQ1B(&D),&&SGDSQ2B(&D),&&SGTRMDB(&D),&&SGSVCAB(255)' 01000000 REPRO 01020000 GBLB &SGCOBLB(4),&SGSVCBB(255),&SGSVCCB(255),&SGSVCDB(255),&SGMALB(11) 01040021 REPRO 01060000 GBLB &SGSVCEB(255),&SGSVCFB(255),&SGFORTB(52),&SGLINKB(19),&SGCBLEB(6) 01080019 REPRO 01100000 GBLB &SGCBLFB(11),&SGLOADB(3),&SGOVERB(4),&SGASSEB(3),&SGPL11B(160) 01120000 REPRO 01140000 GBLB &SGCTRLB(16),&GETB(3),&SGFORLB(5),&SGGRPHB(4),&SGALGOB(5) 01160018 REPRO 01180000 GBLB &SGCHK1B(2),&SGPTOPB(1),&SGNODEV,&SGMOD1B(5),&SGMOD2B(5) 01183017 REPRO 01186017 GBLB &SGMOD3B(5),&SGMOD4B(5),&SGMOD5B(5),&SGMOD6B(5) 01189021 REPRO 01191021 GBLB &SGMOD7B(5),&SGMOD8B(5),&SGMOD9B(5),&SGMODAB(5),&SGMODBB(5) 01191400 REPRO 01192017 GBLB &SGSIZ1B(5),&SGSIZ2B(5),&SGSIZ3B(5),&SGSIZ4B(5),&SGSIZ5B(5) 01195000 REPRO 01196000 GBLB &SGSIZ6B(5),&SGSIZ7B(5),&SGSIZ8B(5),&SGSIZ9B(5),&SGSIZ0B(5) 01197000 REPRO 01198000 GBLB &SGEMULB(1),&SGUTILB(3) 01199000 REPRO 01200018 GBLB &SGSER1B(5),&SGSER2B(5),&SGSER3B(5),&SGSER4B(5),&SGMCSTB(4) 01201017 REPRO 01205017 GBLB &SGSCHRB(16),&SGSCHOB(16),&SGSCHHB(16),&SGLCPB(1) 01208018 REPRO 01209019 GBLB &SGCKPLB(4),&SGCKFTB(4) 01210019 REPRO 01211017 GBLB &SGRT01B(31),&SGRT02B(31),&SGRT03B(31),&SGRT04B(31),&SGRT05B(31) 01212017 REPRO 01213017 GBLB &SGRT06B(31),&SGRT07B(31),&SGRT08B(31),&SGRT09B(31),&SGRT10B(31) 01214017 REPRO 01215017 GBLB &SGRT11B(31),&SGRT12B(31),&SGRT13B(31),&SGRT14B(31),&SGRT15B(31) 01216017 REPRO 01217017 GBLB &SGRT16B(31),&SGCMD1B(31),&SGCMD2B(31),&SGCMD3B(31),&SGCMD4B(31) 01218017 REPRO 01218421 GBLB &SGSCSDB(31),&SGSCMSB(31) 01218821 PUNCH ' GBLB &&SGDUMMY(&D),&&SGDEVB(1),&&SGTYPEB(96)' 01220000 .* * * TEST FOR TSO - SGMINPAK WON'T CONTAIN TSO GLOBALS -- GBLB'S * 01223020 .* THERE ARE NO B-GLOBALS UNIQUE TO TSO 01226020 PUNCH ' GBLC &&SGGJCC(11),&&SGLDRC(3)' 01230018 PUNCH ' GBLC &&SGRESMC(11),&&SGUNNMC(&U),&&SGCTRLC(66)' 01240021 REPRO 01260000 GBLC &SGCPRGC(26) 01280017 PUNCH ' GBLC &&SGSCHDC(15),&&EBCDIC,&&SGLNKLC(&MIN1),&&SGSVCLC(&MIN2)' 01282019 PUNCH ' GBLC &&SGCNTRU,&&SGSCNCC(31),&&SGSCNAC(31)' 01320018 .* * * TEST FOR TSO - SGMINPAK WON'T CONTAIN TSO GLOBALS -- GBLC'S * 01323020 AIF ('&TSO' EQ 'NO').A10 TEST FOR TSO - BRANCH IF NO 01326020 REPRO 01329020 GBLC &SGCLASC(1),&SGEDITC(25),&SGEDT2C(25),&SGEDT3C(25),&SGEDT4C(25) 01331021 REPRO 01333021 GBLC &SGEDT5C(25),&SGEDT6C(25),&SGEDT7C(25) 01333421 .A10 ANOP 01335020 MEND 01340000 ./ ADD SSI=01011525,SOURCE=1,NAME=GDSCB EJECT 00900000 GDSCB DSECT 01800000 GDSNXGDS DS F ADDRESS OF THE NEXT GDS ON 02700000 * THE CHAIN 03600000 GDSGTMCB DS F ADDRESS OF THE GTMCB 04500000 GDSVALID DS X BYTE TO SAY THIS IS A CONTROL BLK 05400000 * X'F2' SETTING 06300000 GDSGDSID DS X BYTE ID TO SAY THIS IS A GDSCB 07200000 * X'03' SETTING 08100000 GDSFLAGS DS X ASSORTED FLAGS 09000000 * X'80' 1=EQUIV IN BUFFER / 0=NOT 09900000 * X'40' 1=CORVAL AT BGSEQ-SUB/0=NO 10800000 * X'20' 1=CURSOR PRES / 0=CURSOR ABSENT 11700000 * X'10' 1=LEVEL 2 GSP / 0=LEVEL 1 GSP 12600000 * X'08' 1=GDS EQUIV / 0=GDS NOT EQUIV 13500000 * X'04' 1=SEQUENCE BEGUN / 0=NO SEQ 14400000 * X'02' 1=SUBROUTINE BEGUN / 0=NO SUBR 15300000 * X'01' 1=PEN MODE PERMIT INT / 0=DISABLE 16200000 GDSFLGS2 DS X MORE FLAGS 17100000 * X'01' 0=SDATL NOT CALLED/1=SDATL CALLED 18000000 GDSAOACB DS F ADDRESS OF THE OACB 18900000 GDSGDSCB DS F ADDRESS OF THIS GDSCB 19800000 GDSKEYTB DS F ADDRESS OF THE KEY TABLE 20700000 GDSXLAST DS F VALUE IN RASTER UNITS OF X COORD 21600000 * OF LAST CALL TO DATA GEN RTN 22500000 GDSYLAST DS F VALUE IN RASTER UNITS OF Y COORD 23400000 * OF LAST CALL TO DATA GEN RTN 24300000 GDSXCURR DS H POSITION OF BEAM IN RASTER UNITS 25200000 * IN THE X DIRECTION 26100000 GDSYCURR DS H POSITION OF BEAM IN RASTER UNITS 27000000 * IN THE Y DIRECTION 27900000 GDSUVLLL DS F VALUE OF LL X COORD OF GRID 28800000 * IN USER UNITS REAL OR INTEGER 29700000 GDSVVLLL DS F VALUE OF LL Y COORD OF GRID 30600000 * IN USER UNITS REAL OR INTEGER 31500000 GDSUVLUR DS F VALUE OF UR X COORD OF GRID 32400000 * IN USER UNITS REAL OR INTEGER 33300000 GDSVVLUR DS F VALUE OF UR Y COORD OF GRID 34200000 * IN USER UNITS REAL OR INTEGER 35100000 GDSXVILL DS F VALUE OF LL X COORD OF GRID 36000000 * IN RASTER UNITS INTEGER 36900000 GDSYVILL DS F VALUE OF LL Y COORD OF GRID 37800000 * IN RASTER UNITS INTEGER 38700000 GDSXVIUR DS F VALUE OF UR X COORD OF GRID 39600000 * IN RASTER UNITS INTEGER 40500000 GDSYVIUR DS F VALUE OF UR Y COORD OF GRID 41400000 * IN RASTER UNITS INTEGER 42300000 GDSXVRLL DS F VALUE OF LL X COORD OF GRID 43200000 * IN RASTER UNITS REAL 44100000 GDSYVRLL DS F VALUE OF LL Y COORD OF GRID 45000000 * IN RASTER UNITS REAL 45900000 GDSXVRUR DS F VALUE OF UR X COORD OF GRID 46800000 * IN RASTER UNITS REAL 47700000 GDSYVRUR DS F VALUE OF UR Y COORD OF GRID 48600000 * IN RASTER UNITS REAL 49500000 EJECT 50400000 GDSCHARS DS X CHARACTER OPTION FLAGS 51300000 * X'08' BASIC PROTECTED 52200000 * X'04' LARGE PROTECTED 53100000 * X'02' BASIC UNPROTECTED 54000000 * X'01' LARGE UNPROTECTED 54900000 GDSSCISS DS X SCISSOR OPTION FLAGS 55800000 * X'10' NO SCISSORING 56700000 * X'08' SCISSOR AT SCREEN 57600000 * X'04' SCISSOR AT GRID 58500000 * X'02' CONTINUE GENERATION 59400000 * X'01' STOP GENERATION 60300000 GDSCURMD DS X OUTPUT DATA MODE 61200000 * X'04' OPTIMIZED 62100000 * X'02' ABSOLUTE 63000000 * X'01' INCREMENTAL 63900000 GDSDATMD DS X INPUT DATA MODE 64800000 * X'80' U IS REAL, ABSOLUTE 65700000 * X'40' U IS REAL, INCREMENTAL 66600000 * X'20' U IS INTEGER, ABSOLUTE 67500000 * X'10' U IS INTEGER, INCREMENTAL 68400000 * X'08' V IS REAL, ABSOLUTE 69300000 * X'04' V IS REAL, INCREMENTAL 70200000 * X'02' V IS INTEGER, ABSOLUTE 71100000 * X'01' V IS INTEGER, INCREMENTAL 72000000 GDSOVDAT DS F GTRU TO FLOW CONTROL USED 72900000 * WHEN THE GDS IS EXECUTED. 73800000 GDSFCBUF DS H BUFFER ADDRESS OF FLOW CTL ENTRY 74700000 GDSBCTEL DS H PTR TO ELEMENT IN THE BUFFER 75600000 * CONTROL TABLE WHICH IS FIRST 76500000 GDSBCTID DS X ID OF GDS IN BUFFER CONTROL TABLE 77400000 GDSGRMOD DS X CURRENT MODE DEVICE IS IN 78300000 * X'80' CHARACTER PROTECTED BASIC 79200000 * X'40' CHARACTER PROTECTED LARGE 80100000 * X'20' CHARACTER UNPROTECTED BASIC 81000000 * X'10' CHARACTER UNPROTECTED LARGE 81900000 * X'08' VECTOR ABSOLUTE 82800000 * X'04' VECTOR INCREMENTAL 83700000 * X'02' POINT ABSOLUTE 84600000 * X'01' POINT INCREMENTAL 85500000 * X'00' CONTROL 86400000 GDSGDOAL DS H LENGTH OF EACH GDOA 87300000 GDSSHDBK DS F POINTER BACK TO THE EQUIV GDS 88200000 GDSSHDFD DS F POINTER FOREWARD TO THE EQUIV GDS 89100000 GDSREPPB DS H REPLACEMENT PHYSICAL BUFFER ADDR 90000000 GDSKEYSV DS H LOGICAL START ADDRESS OF KEY FOR 90900000 * BUFFER SUBROUTINE OR SEQUENCE 91800000 * CURRENTLY BEING GENERATED 92700000 GDSREPDT DS F DATA TO REPLACE THE GTRU TO FC 93600000 ./ ADD SSI=01030072,SOURCE=1,NAME=GENCCWDS MACRO 00700000 GENCCWDS &TYPE=DSECT 01400000 AIF ('&TYPE' EQ 'DSECT').GO 02100000 IHKGCW CSECT CHANNEL PROGRAM GENERATORS 02800000 AGO .GO2 03500000 .GO ANOP 04200000 GENCCWDS DSECT , DEFINITION OF GENERATOR LINKAGE 04900000 IHKGCW EQU * 05600000 GENMASGN EQU * 06300000 NDXINTGN EQU * 07000000 CHKNDXGN EQU * 07700000 LOCNDXGN EQU * 08400000 OLDNDX EQU * 09100000 NUINGN EQU * 09800000 WRITECK EQU * 10500000 WRECCHAN EQU * 11200000 GETRECGN EQU * 11900000 INSRTREC EQU * 12600000 REPLCREC EQU * 13300000 DUMMYGN EQU * 14000000 GETXKEY EQU * 14700000 RDKEY EQU * 15400000 NDXUGN EQU * 16100000 RDTLSTGN EQU * . 16800000 RDRTCHAN EQU * . 17500000 RDALLKGN EQU * . 18200000 SRCHKEY EQU * . 18900000 RDDKEY EQU * . 19600000 RDRCHNGN EQU * . 20300000 RDRTCHN0 EQU * . 21000000 RDTCGN EQU * 21700000 READKWC EQU * 22400000 .GO2 ANOP 23100000 GEN EQU * . ORIGIN OF CCW GENERATOR ROUTINE TABLE 23800000 DUMMYCW EQU *-GEN . NOP. MUST BE FIRST IN TABLE. 24500000 DC Y(DUMMYGN-GEN) . 25200000 GENMASCW EQU *-GEN . GENERATE MASTER INDEX RECORD 25900000 DC Y(GENMASGN-GEN) . 26600000 NDXINTCW EQU *-GEN . FORMAT INDEX RECORD 27300000 DC Y(NDXINTGN-GEN) . 28000000 CHKNDXCW EQU *-GEN . CHECKPOINT INDEX RECORD ADDRESS 28700000 DELNDXCW EQU *-GEN . RESET MASTER INDEX ENTRY 29400000 FRSTR1CW EQU *-GEN . UPDATE EOS FOR FIRST SEGMENT 30100000 DC Y(CHKNDXGN-GEN) . IN MASTER INDEX (GENERATOR). 30800000 LOCNDXCW EQU *-GEN . LOCATE INDEX TRACK THROUGH MASTER 31500000 MAST1CW EQU *-GEN . 32200000 DC Y(LOCNDXGN-GEN) . INDEX 32900000 OLDXCCWS EQU *-GEN . OLD INDEX CHARACTERISTICS CCW'S 33600000 DC Y(OLDNDX-GEN) . 34300000 NUINCW EQU *-GEN . 35000000 DC Y(NUINGN-GEN) . 35700000 RDTLSTCW EQU *-GEN . 36400000 DC Y(RDTLSTGN-GEN) . 37100000 WRITCKCW EQU *-GEN . WRITE CHECK DATA TRACK 37800000 DC Y(WRITECK-GEN) . 38500000 WRCHANCW EQU *-GEN . OUTPUT RECORD CHAIN 39200000 DC Y(WRECCHAN-GEN) . 39900000 RDTCCW EQU *-GEN 40600000 DC Y(RDTCGN-GEN) 41300000 GETRECW EQU *-GEN . READ A DATA RECORD 42000000 DC Y(GETRECGN-GEN) . 42700000 INSCW EQU *-GEN . INSERT A DATA RECORD 43400000 DC Y(INSRTREC-GEN) . 44100000 REPRECW EQU *-GEN . REPLACE A DATA RECORD 44800000 DC Y(REPLCREC-GEN) . 45500000 GETXKCW EQU *-GEN . READ KEY WITH WRITE CHECKING 46200000 DC Y(GETXKEY-GEN) . 46900000 REDKWCCW EQU *-GEN 47600000 DC Y(READKWC-GEN) 48300000 RDKEYCW EQU *-GEN . SIMPLE READ OF KEY FIELD 49000000 DC Y(RDKEY-GEN) . 49700000 NDXUCW EQU *-GEN . 50400000 DC Y(NDXUGN-GEN) . 51100000 RDRTCCW EQU *-GEN 51800000 DC Y(RDRTCHAN-GEN) 52500000 RDALLKCW EQU *-GEN 53200000 DC Y(RDALLKGN-GEN) 53900000 SRCHKYCW EQU *-GEN 54600000 DC Y(SRCHKEY-GEN) 55300000 RDDKEYCW EQU *-GEN 56000000 DC Y(RDDKEY-GEN) 56700000 RDRCHNCW EQU *-GEN 57400000 DC Y(RDRCHNGN-GEN) 58100000 RDRTCW0 EQU *-GEN 58800000 DC Y(RDRTCHN0-GEN) 59500000 AIF ('&TYPE' EQ 'DSECT').GO4 60200000 * 60900000 *********************************************************************** 61600000 * 62300000 * SORTNTR - SORT THE SEARCH ARGUMENT LIST BY RECORD NUMBER AND 63000000 * BRANCH TO THE CCW GENERATOR SUBROUTINES AS SPECIFIED. 63700000 * 64400000 * INPUT REGISTERS: CCWRG = ORIGIN OF CCW LIST - 8. 65100000 * SRCHRG = ORIGIN OF SEARCH ARGUMENT LIST - 8 65800000 * GR0RG = LENGTH OF SEARCH ARGUMENT LIST 66500000 * 67200000 AGO .GO5 67900000 .GO4 ANOP 68600000 USING IHKGCW,BASERG 69300000 USING RAFKNBX,KBXRG 70000000 USING EXCPFWDS,AFWRG 70700000 USING CNTSRCH,SRCHRG 71400000 USING CCWMSK,CCWRG 72100000 .GO5 ANOP 72800000 SORTNTR DS 0H . SORT ENTRY POINT FROM SCHEDULER 73500000 CHAN001 LR LINK1RG,GR0RG . 74200000 SLA LINK1RG,3 . ESTABLISH INDEX REGISTER 74900000 L GR3RG,FCOUNT1 . HI-ORDER BYTE IS RECORD NUMBER 75600000 CHAN002 CL GR3RG,FCOUNT0(LINK1RG) . 76300000 BNE CHAN003 . BRANCH IF NOT THROUGH WITH SORT 77000000 LH LINK1RG,GEN(GR3RG) . PICK UP ROUTINE DISPLACEMNT 77700000 BAL LINK1RG,IHKGCW(LINK1RG) AND GO TO GENERATOR 78400000 BCT GR0RG,CHAN001 . BACK FOR MORE IF NOT FINISHED 79100000 B CHAN006 . EXIT TABLE DRIVEN CCW GENERATOR 79800000 CHAN003 BL CHAN004 . BRANCH IF NOT LOWER THAN FIRST 80500000 LA GR1RG,SRCHARG0(LINK1RG) . 81200000 LM GR2RG,GR3RG,0(GR1RG) . PICK UP NEW LOW ENTRY 81900000 MVC 0(8,GR1RG),SRCHARG1 . MOVE OLD LOW TO NEW'S OLD PLACE 82600000 STM GR2RG,GR3RG,SRCHARG1 . STORE NEW LOW 83300000 CHAN004 SH LINK1RG,H8KN . BUMP TO NEXT LIST ENTRY 84000000 B CHAN002 . 84700000 SORTLGH EQU *-SORTNTR . NON-SORT ENTRY POINT 85400000 CHAN005 L GR3RG,FCOUNT1 . PICK UP LINKAGE TABLE INDEX 86100000 LH LINK1RG,GEN(GR3RG) . LOCATE ROUTINE DISPLACEMENT 86800000 BAL LINK1RG,IHKGCW(LINK1RG) AND GO THERE 87500000 BCT GR0RG,CHAN005 . CONTINUE IF MORE ARGUMENTS 88200000 CHAN006 NI CCWFLGS0,X'FF'-CC . RESET LAST CC FLAG IF ON 88900000 GENRET L LINK1RG,EXRET2LK . RETURN TO SCHEDULER WITH COMPLETE 89600000 BR LINK1RG . CHANNEL PROGRAM 90300000 AIF ('&TYPE' EQ 'DSECT').GO7 91000000 MEXIT 91700000 .GO7 ANOP 92400000 DROP BASERG . 93100000 DROP KBXRG . 93800000 DROP AFWRG . 94500000 DROP SRCHRG . 95200000 DROP CCWRG . 95900000 MEND 96600000 ./ ADD SSI=01012934,SOURCE=1,NAME=GETJSCB MACRO 05000019 &MACNAME GETJSCB &SYSTEM=MVT 10000019 AIF ('&SYSTEM' EQ 'MVT').GETMVT 15000019 AIF ('&SYSTEM' EQ 'MFT').GETMFT 20000019 MNOTE ,'ONLY MFT OR MVT VALID AS SYSTEM PARAMETERS' 25000019 MEXIT 30000019 .GETMFT ANOP 35000019 &MACNAME GETMAIN R,LV=JSCBMFTL,SP=255 40000019 XC 0(JSCBMFTL,1),0(1) CLEAR GOTTEN CORE 45000019 AGO .SETADDR 50000019 .GETMVT ANOP 55000019 &MACNAME GETMAIN R,LV=JSCBMVTL,SP=253 60000019 XC 0(JSCBMVTL,1),0(1) CLEAR GOTTEN CORE 65000019 .SETADDR ANOP 70000019 LA 15,JSCBDISP - LOAD DISPLACEMENT OF FIRST BYTE IN JSCB 75000019 SR 1,15 - COMPUTE ADDRESS TO BE STORED IN TCB 80000019 MEXIT 85000019 MEND 90000019 ./ ADD SSI=01012321,SOURCE=1,NAME=GLOBAL MACRO 10000020 GLOBAL 20000020 GBLB &E536454 30000020 &E536454 SETB 1 40000020 MEND 50000020 ./ ADD SSI=01013240,SOURCE=1,NAME=GSPCB EJECT 04000013 GSPCB DSECT 08000013 GSPGTMCB DS F ADDRESS OF THE FIRST GTMCB 12000013 * ON THE CHAIN 16000013 GSPDCTR2 DS F ADDRESS OF PART 2 OF THE DIRECTOR 20000013 GSPSYSID DS X BYTE TO SAY THIS IS A CONTROL BLK 24000013 * X'F2' SETTING 28000013 GSPCBID DS X ID TO SAY THIS IS A GSPCB 32000013 * X'01' SETTING 36000013 GSPBUSYS DS X GSP BUSY SWITCH 40000013 * X'00' GSP NOT BUSY 44000013 * X'FF' GSP BUSY 48000013 GSPFLAGS DS X ASSORTED FLAGS 52000013 * X'01' 1=IN DE / 0= NOT IN DE 56000013 GSPDECNT DS X COUNT OF DIRECT ENTRIES PENDING 60000013 GSPAWORK DS F ADDRESS OF WORK AREA 64000013 GSPSTRTB DS F ADDRESS OF THE STROKE TABLE 68000013 GSPARRAY DS 5F GSP RETURN ARRAY 72000013 GSPNULLV DS F THE ADDRESS TO BE RECOGNIZED 76000013 * AS THE ABSENCE OF A PARAMETER 80000013 GSPASTAT DS F ADDRESS OF STATUS TABLE 84000013 GSPAEXIT DS F ADDR OF USER EXIT RTN, INGSP ARG 3 91000019 ./ ADD SSI=01011525,SOURCE=1,NAME=GTMCB EJECT 01000000 GTMCB DSECT 02000000 GTMNXGTM DS F ADDRESS OF THE NEXT GTMCB 03000000 GTMGSPCB DS F ADDRESS OF THE GSPCB 04000000 GTMVALID DS X BYTE TO SAY THIS IS A CONTROL BLK 05000000 * X'F2' SETTING 06000000 GTMTERID DS X ID TO SAY THIS IS A GTMCB 07000000 * X'02' SETTING 08000000 GTMGTMCB DS F ADDRESS OF THIS GTMCB 09000000 GTMGRDCB DS F ADDRESS OF DCB 10000000 GTMGDSCB DS F ADDRESS OF FIRST GDSCB ON TRM 11000000 GTMLATBL DS F ADDRESS OF ACTIVE ATTN LEVEL 12000000 GTMGACBA DS F ADDRESS OF GACB 13000000 GTMSYGDS DS F ADDRESS OF SYSTEM GDSCB 14000000 GTMBCTBL DS F ADDRESS OF BUFFER CTL TABLE 15000000 GTMFCTBL DS F ADDRESS OF FLOW CTL TABLE 16000000 GTMPFKSS DS F PROGRAM FUNCTION KEY STATUS 17000000 GTMFEATS DS H CHARACTERISTICS OF THE DEVICE 18000000 * BYTE 0 19000000 * X'01' MODEL 1 2250 20000000 * X'02' MODEL 2 2250 21000000 * X'03' MODEL 3 2250 22000000 * BYTE 1 23000000 * X'10' PROGRAM FUNCTION KEYBOARD 24000000 * X'20' LIGHT PEN 25000000 * X'40' ALPHAMERIC KEYBOARD 26000000 * X'80' ABSOLUTE VECTORS 27000000 * X'08' CHARACTER GENERATOR 28000000 * X'04' GRAPHIC DESIGN FEATURE 29000000 GTMREPOS DS H LOCATION OF REPOS VECT IN TRKG 30000000 GTMDECB1 DS F ADDRESS OF THE SYSTEM DECB 31000000 GTMGDOAL DS H GDOA LENGTH FOR GDS'S ON TERMINAL 32000000 * MAY BE OVERRIDEN AT GDS LEVEL 33000000 GTMDVADR DS H DEVICE ADDRESS (2E0,1D0,ETC.) 34000000 GTMATTNO DS H ATTENTION OPTIONS 35000000 GTMCRLOC DS H POINTER TO BUFFER LOCATION 36000000 * TO CONTAIN CURSOR 37000000 GTMBCTSM DS X INDEX TO UNIQUE NUMBER FOR 38000000 * BUFFER MANAGEMENT 39000000 GTMBCTLG DS X INDEX TO UNIQUE NUMBER FOR 40000000 * BUFFER MANAGEMENT 41000000 GTMFLAGS DS X ASSORTED FLAGS 42000000 * X'08' 1=TRACKING IN / 0=NOT 43000000 * X'04' 1=DE IN PROG / 0=DE NOT IN PROG 44000000 * X'02' 1=DIRECT ENTRY PEND / 0=NOT 45000000 * X'01' 1=CURSOR IN TRML / 0=NOT 46000000 GTMLIGHT DS X LIGHT OPTION BYTE 47000000 * X'02' LIGHT PFK ZERO (DEFAULT) 48000000 * X'03' LIGHT ENABLED KEYS 49000000 * X'04' LIGHT AS PER LIGHT MASK(GTMPFKSS) 50000000 ./ ADD SSI=01011920,SOURCE=1,NAME=HCT * %GO TO DCLHCT; /* 00400021 MACRO 00800021 &L HCT 01200021 .*A000000-999999 S21014 01250021 AIF ('&L' EQ '').HCTL 01600021 &L DSECT , . HOOK CONTROL TABLE 02000021 AGO .HCTN 02400021 .HCTL ANOP 02800021 HCT DSECT , . HOOK CONTROL TABLE 03200021 .HCTN ANOP 03600021 HCTNHCT DS A . POINTER TO NEXT HCT 04000021 HCTNDAC EQU 128 . PERM DEACT FLAG FOR NEXT HCT 04400021 HCTROUT DS A . ROUTER ADDR (NORMAL) 04800021 HCTROUTB DS A . ROUTER ADDR (BRANCH) 05200021 HCTRCOV DS A . ERROR MONITOR ADDR 05600021 HCTCIR DS A . CONTROL INITIALIZATION RTN ADDR 06000021 HCTGTF DS 0F . GTF FLAGS AND ADDR 06400021 HCTGTFST DS XL1 . GTF STATUS FLAGS 06800021 HCTGTFS EQU 128+64 . GTF STATUS (ACTIVE/ NOT ACTIVE) 07200021 HCTSTATE EQU 32 . GTF STATE ( ENAB / DISAB) 07600021 HCTMODE EQU 16 . TRACE MODE ( 0=INT , 1=EXT) 08000021 HCTFORM EQU 8 . FORMAT CONTROL ( 0=NO , 1=YES) 08400021 HCTGTFRS EQU 4 . RESERVED 08800021 HCTMCTYP EQU 2 . MC TYPE ( 0=SIMULATED, 1=REAL) 09200021 HCTGTFAD DS AL3 . REGION MONITOR WORD 09600021 HCTTCB DS A . TCB OF GTF AND RMON 10000021 HCTFLG1 DS XL1 . HCT STATUS FLAGS 1 10400021 HCTCONST EQU 128 . UNDER-CONSTRUCTION 10800021 HCTTERMD EQU 64 . FUNCTION BEING TERMINATED 11200021 HCTACTIV EQU 32 . HCT ACTIVE 11600021 HCTINCTL EQU 16 . IN ROUTER OR APPLICATION 12000021 HCTINAPP EQU 8 . APPLICATION IN CONTROL 12400021 HCTDWRAP EQU 4 . DA WRAP CONTROL (0=NO, 1=YES) 12800021 HCTCLSDN EQU 2 . DA WRAP CLOSEDOWN (0=NO, 1=YES) 13200021 HCTDYNHK EQU 1 . RESERVED 13600021 HCTFLG2 DS XL1 . HCT STATUS FLAG 2 14000021 HCTTMSTP EQU 128 . TIMESTAMP BUFFER HEADER 14400021 HCTSTKOP EQU 64 . OPTION FIELD IN BUFFER HEADER 14800021 HCTSTKAB EQU 32 . ATERM IF BUFFER OVERRUN 15200021 HCTSYSOP EQU 16+8 . SYSTEM OPTION ( 00 = MVT) 15600021 HCTSYSMP EQU 16 . SYSTEM OPTION ( 1 = MP65) 16000021 HCTSYSMF EQU 8 . SYSTEM OPTION ( 1 = MFT) 16400021 HCTTSAME EQU 4 . TIME STAMP CONSISTENCY FLAG 16800021 HCTTODCK EQU 2 . TOD CLOCK BIT 17200021 HCTTMTYP EQU 1 . TIMER TYPE (0=LOWRES, 1=HIRES) 17600021 HCTNMCT DS H . NUMBER OF ENTRIES IN MCT 18000021 HCTMCT DS A . MONITOR CONTROL TABLE ADDR 18400021 HCTRCB DS A . ROUTER CONTROL BLOCK ADDR 18800021 HCTERM DS A . ERROR MONITOR TABLE ADDR 19200021 HCTGTF1 DS 0F . FLAGS AND TVT ADDR 19600021 HCTFLG3 DS XL1 . TVT FLAGS 20000021 HCTTIME EQU 128 . TIMESTAMP RCDS ( 0=NO,1=YES) 20400021 HCTDEBUG EQU 64 . DEBUG CONTROL ( 0=NO, 1=YES) 20800021 HCTTVT DS AL3 . TRACE VECTOR TABLE ADDR 21200021 HCTTMCR DS F . TIME CORRECTION VALUE 21600021 HCTXTTIM DS 0FL8 . EXTENDED TOTAL TIME 22000021 DS F . EXTENSION 22400021 HCTTTIM DS F . TOTAL TIME IN MONITOR 22800021 HCTXCMSK DS 0F . EXTENDED CLASS MASK 23200021 DS FL2 . EXTENSION 23600021 HCTCMSK DS FL2 . CLASS MASK FOR THIS HCT 24000021 HCTNAME DS CL8 . NAME OF FUNCTION 24400021 HCTCTLCT DS F . CONTROL COUNT FIELD 24800021 HCTWECB DS A . I/O ROUTINE ECB ADDR 25200021 HCTBCUR DS 0CL12 . CURRENT BUFFER PTR ARRAY 25600021 HCTTCUR DS A . CURRENT TRC BUFFER 26000021 HCTSCUR DS A . CURRENT SMG BUFFER 26400021 HCTWCUR DS A . CURRENT WTO BUFFER 26800021 HCTBWBF DS 0CL12 . OLDEST SCHEDULED PTR ARRAY 27200021 HCTTWBF DS A . OLDEST SCHEDULED TRC BUFFER 27600021 HCTSWBF DS A . OLDEST SCHEDULED SMG 28000021 HCTWWBF DS A . OLDEST SCHEDULED WTO 28400021 HCTBNSC DS 0CL12 . NEXT TO BE SCHED PTR ARRAY 28800021 HCTTNSC DS A . NEXT TO BE SCHED TRC BUFFER 29200021 HCTSNSC DS A . NEXT TO BE SCHED SMG BUFFER 29600021 HCTWNSC DS A . NEXT TO BE SCHED WTO BUFFER 30000021 HCTSDATA DS A . SERVICE RTN'S DATA AREA ADDR 30400021 HCTSOPT DS 0F . USER OPTION FIELD 30800021 HCTSOPTL DS FL1 . OPTION FIELD LENGTH 31200021 HCTSOPTA DS AL3 . OPTION FIELD ADDR 31600021 HCTSTK DS A . STACK SERVICE E.P. 32000021 HCTSTKS DS A . STACKS 32400021 HCTSTKW DS A . STACKW 32800021 HCTDISAB DS A . DISABLE 33200021 HCTENAB DS A . ENABLE 33600021 HCTSCMSK DS A . SETCMASK 34000021 HCTNTERM DS A . NTERM 34400021 HCTATERM DS A . ATERM 34800021 HCTINIT DS A . INITIAL 35200021 HCTFEOB DS A . FEOB 35600021 HCTOCTAB DS A . RESERVED 36000021 HCTPIN DS A . RESERVED 36400021 HCTPOUT DS A . RESERVED 36800021 MEND , */ 37200021 * %DCLHCT: ; 37600021 * DCL HCTBASE PTR(31) REG(2); 38000021 * RESTRICT (HCTBASE); 38400021 * DCL 1 HCT BASED(HCTBASE), /* HOOK CONTROL TABLE */ 38800021 * 2 HCTNHCT PTR(31), /* POINTER TO NEXT HCT. */ 39200021 * 3 HCTNDAC BIT(1), /* PERM DEACT OF NXT HCT*/ 39600021 * 2 HCTROUT PTR(31), /* ROUTER ADDR (NORMAL) */ 40000021 * 2 HCTROUTB PTR(31), /* ROUTER ADDR (BRANCH) */ 40400021 * 2 HCTRCOV PTR(31), /* ERROR MONITOR ADDR. */ 40800021 * 2 HCTCIR PTR(31), /* CTL INITIALIZATION RT*/ 41200021 * 2 HCTGTF PTR(32), /* GTF FLAGS AND ADDR. */ 41600021 * 3 HCTGTFST BIT(8), /* GTF STATUS FLAGS */ 42000021 * 4 HCTGTFS BIT(2), /* GTF STATUS. */ 42400021 * /* 00 = NOT ACTIVE */ 42800021 * /* 01 = STARTING */ 43200021 * /* 10 = STOPPING */ 43600021 * /* 11 = ACTIVE */ 44000021 * 4 HCTSTATE BIT(1), /* GTF STATE. ENB/DIS */ 44400021 * /* 0 = DISABLED */ 44800021 * /* 1 = ENABLED */ 45200021 * 4 HCTMODE BIT(1), /* TRACE MODE */ 45600021 * /* 0 = INTERNAL */ 46000021 * /* 1 = EXTERNAL */ 46400021 * 4 HCTFORM BIT(1), /* FORMAT CONTROL */ 46800021 * /* 0 = DON'T FORMAT */ 47200021 * /* 1 = FORMAT */ 47600021 * 4 HCTGTFRS BIT(1), /* RESERVED FOR GTF */ 48000021 * 4 HCTMCTYP BIT(1), /* 0=SIMULATED,1=REAL */ 48400021 * 4 * BIT(1), /* RESERVED */ 48800021 * 3 HCTGTFAD PTR(24), /* REGION MONITOR WORD */ 49200021 * 2 HCTTCB PTR(31), /* TCB OF GTF AND RMON */ 49600021 * 2 HCTFLG1 BIT(8), /* HCT STATUS FLG1 */ 50000021 * 3 HCTCONST BIT(1), /* UNDERCONSTRUCTION FLG*/ 50400021 * 3 HCTTERMD BIT(1), /* FUNC BEING TERMINATED*/ 50800021 * 3 HCTACTIV BIT(1), /* HCT ACTIVE */ 51200021 * 3 HCTINCTL BIT(1), /* IN ROUTER OR APPL. */ 51600021 * 3 HCTINAPP BIT(1), /* APPLICATION IN CONTRL*/ 52000021 * 3 HCTDWRAP BIT(1), /* DA WRAP CONTROL */ 52400021 * /* 0=NOT LOADED,1=LOADED*/ 52800021 * 3 HCTCLSDN BIT(1), /* DA WRAP CLOSEDOWN IND*/ 53200021 * /* 0=NOT IN CLOSEDOWN */ 53600021 * /* 1=IN CLOSEDOWN */ 54000021 * 3 HCTDYNHK BIT(1), /* RESERVED */ 54400021 * 2 HCTFLG2 BIT(8), /* HCT STATUS FLG2 */ 54800021 * 3 HCTTMSTP BIT(1), /* TIME STMP BUFF HDR */ 55200021 * 3 HCTSTKOP BIT(1), /* OPTION FLD IN BUFF HD*/ 55600021 * 3 HCTSTKAB BIT(1), /* ATERM IF BUFF OVERRUN*/ 56000021 * 3 HCTSYSOP BIT(2), /* 00 = MVT */ 56400021 * /* 01 = MFT */ 56800021 * /* 10 = MP65 */ 57200021 * 3 HCTTSAME BIT(1), /* TIMESTAMP CONSISTENCY*/ 57600021 * 3 HCTTODCK BIT(1), /* TOD CLOCK BIT */ 58000021 * 3 HCTTMTYP BIT(1), /* 0=LOW RES,1=HI RES */ 58400021 * 2 HCTNMCT FIXED(15), /* NO. ENTRIES IN MCT */ 58800021 * 2 HCTMCT PTR(31), /* MONITOR CONTROL TBL */ 59200021 * 2 HCTRCB PTR(31), /* ROUTER CONTROL BLOCK */ 59600021 * 2 HCTERM PTR(31), /* ERROR MONITOR TABEL */ 60000021 * 2 HCTGTF1 PTR(32), /* FLAGS AND TVT ADDRESS*/ 60400021 * 3 HCTFLG3 BIT(8), /* FLAGS */ 60800021 * 4 HCTTIME BIT(1), /* 0=DONT TMPSTMP RCDS */ 61200021 * /* 1=TMPSTMP RCDS */ 61600021 * 4 HCTDEBUG BIT(1), /* DEBUG CONTROL */ 62000021 * /* 0=NOT DEBUG,1=DEBUG */ 62400021 * 4 * BIT(6), /* RESERVED */ 62800021 * 3 HCTTVT PTR(24), /* TRACE VECTOR TAB ADDR*/ 63200021 * 2 HCTTMCR FIXED(31), /* TIME CORRECTION */ 63600021 * 2 HCTXTTIM CHAR(8) BDY(WORD), /*EXTENDED HCTTTIM */ 64000021 * 3 * PTR(32), /* EXTENSION */ 64400021 * 3 HCTTTIM PTR(32), /* TIME IN GTF */ 64800021 * 2 HCTXCMSK BIT(32), /* EXTENDED CLASS MARK */ 65200021 * 3 * BIT(16), /* EXTENSION */ 65600021 * 3 HCTCMSK BIT(16), /* CLASS MASK FOR THIS */ 66000021 * /* HCT. 0=OFF 1=ON */ 66400021 * 2 HCTNAME CHAR(8), /* NAME OF FUNCTION */ 66800021 * 2 HCTCTLCT PTR(31), /* CONTROL COUNT FIELD */ 67200021 * 2 HCTWECB PTR(31), /* I/O ROUTINE ECB ADDR */ 67600021 * 2 HCTTCUR PTR(31), /* CURRENT TRC BUFF */ 68000021 * 2 HCTSCUR PTR(31), /* CURRENT SMG BUFF */ 68400021 * 2 HCTWCUR PTR(31), /* CURRENT WTO BUFF */ 68800021 * 2 HCTTWBF PTR(31), /* OLDEST SCHEDULED TRCB*/ 69200021 * 2 HCTSWBF PTR(31), /* OLDEST SCHEDULED SMGB*/ 69600021 * 2 HCTWWBF PTR(31), /* OLDEST SCHEDULED WTOB*/ 70000021 * 2 HCTTNSC PTR(31), /* NEXT TO BE SCHED TRCB*/ 70400021 * 2 HCTSNSC PTR(31), /* NEXT TO BE SCHED SMGB*/ 70800021 * 2 HCTWNSC PTR(31), /* NEXT TO BE SCHED WTOB*/ 71200021 * 2 HCTSDATA PTR(31), /* SERVICE RTNS' DATAREA*/ 71600021 * 2 HCTSOPT PTR(32), /* USER OPTION FIELD */ 72000021 * 3 HCTSOPTL PTR(8), /* OPTION FIELD LENGTH */ 72400021 * 3 HCTSOPTA PTR(24), /*OPTION FIELD ADDRESS */ 72800021 * 2 HCTSTK PTR(31), /* STACK SERVICE E.P. */ 73200021 * 2 HCTSTKS PTR(31), /* STACKS SERVICE E.P. */ 73600021 * 2 HCTSTKW PTR(31), /* STACKW SERVICE E.P. */ 74000021 * 2 HCTDISAB PTR(31), /* DISABLE SERVICE E.P. */ 74400021 * 2 HCTENAB PTR(31), /* ENABLE SERVICE E.P. */ 74800021 * 2 HCTSCMSK PTR(31), /* SETCMASK SERVICE E.P.*/ 75200021 * 2 HCTNTERM PTR(31), /* NTERM SERVICE E.P. */ 75600021 * 2 HCTATERM PTR(31), /* ATERM SERVICE E.P. */ 76000021 * 2 HCTINIT PTR(31), /* INITIAL SERVICE E.P. */ 76400021 * 2 HCTFEOB PTR(31), /* FORCE END OF BLOCK EP*/ 76800021 * 2 HCTOCTAB PTR(31), /* RESERVED */ 77200021 * 2 HCTPIN PTR(31), /* RESERVED */ 77600021 * 2 HCTPOUT PTR(31); /* RESERVED. */ 78000021 * DCL HCTBCUR(3) PTR(31) BASED(ADDR(HCTTCUR)), 78400021 * /* CURRENT BUF PTR ARRAY*/ 78800021 * HCTBWBF(3) PTR(31) BASED(ADDR(HCTTWBF)), 79200021 * /* OLDEST SCHEDULD ARRAY*/ 79600021 * HCTBNSC(3) PTR(31) BASED(ADDR(HCTTNSC)); 80000021 * /* NEXT TO BE SCHD ARRAY*/ 80400021 * DCL STACK ENTRY BASED(HCTSTK) OPTIONS(VLIST), 80800021 * STACKS ENTRY BASED(HCTSTKS) OPTIONS(VLIST), 81200021 * STACKW ENTRY BASED(HCTSTKW) OPTIONS(VLIST), 81600021 * DISABLE ENTRY BASED(HCTDISAB) OPTIONS(VLIST), 82000021 * ENABLE ENTRY BASED(HCTENAB) OPTIONS(VLIST), 82400021 * SETCMASK ENTRY BASED(HCTSCMSK) OPTIONS(VLIST), 82800021 * NTERM ENTRY BASED(HCTNTERM) OPTIONS(VLIST), 83200021 * ATERM ENTRY BASED(HCTATERM) OPTIONS(VLIST), 83600021 * INITIAL ENTRY BASED(HCTINIT) OPTIONS(VLIST), 84000021 * FEOB ENTRY BASED(HCTFEOB) OPTIONS(VLIST); 84400021 * %DCL SHOOK FIXED, /* STACK OPTION */ 84800021 * SADDR FIXED, /* STACK OPTION */ 85200021 * NOTIME FIXED; /* STACK OPTION */ 85600021 * %SHOOK=2; /* HOOK VALUE IN RECORD */ 86000021 * %SADDR=1; /* HOOK ADDR IN RECORD */ 86400021 * %NOTIME=4; /* NO TIMESTAMP IN REC */ 86800021 * %DCL DUMP FIXED; /* NTERM & ATERM OPTION */ 87200021 * %DUMP=1; /* DUMP REGION ON TERM */ 87600021 * %DCL TRCBUFF FIXED, /* INITIAL & FEOB OPTION*/ 88000021 * SMGBUFF FIXED, /* INITIAL & FEOB OPTION*/ 88400021 * WTOBUFF FIXED, /* INITIAL & FEOB OPTION*/ 88800021 * NOTOVRD FIXED, /* INITIAL OPTION */ 89200021 * TIMESTMP FIXED, /* INITIAL OPTION */ 89600021 * TRCDEFR FIXED, /* INITIAL OPTION */ 90000021 * SMGDEFR FIXED, /* INITIAL OPTION */ 90400021 * WTODEFR FIXED, /* INITIAL OPTION */ 90800021 * GTFAID FIXED; /* INITIAL OPTION */ 91200021 * %TRCBUFF=4; /* GET TRC BUFFS & OPEN */ 91600021 * %SMGBUFF=2; /* GET SMG BUFFS & OPEN */ 92000021 * %WTOBUFF=1; /* GET WTO BUFFS & OPEN */ 92400021 * %NOTOVRD=8; /* OVERRIDES NOT ALLOWED*/ 92800021 * %TIMESTMP=16; /* TIMESTAMP EACH TRCBUF*/ 93200021 * %TRCDEFR=32; /* GET TRC BUFFS LATER */ 93600021 * %SMGDEFR=64; /* GET SMG BUFFS LATER */ 94000021 * %WTODEFR=128; /* GET WTO BUFFS LATER */ 94400021 * %GTFAID=256; /* GIVE GTF AID TO APPLS*/ 94800021 ./ ADD SSI=01011929,SOURCE=1,NAME=HDATA * %GO TO DCLHDA; /* 01000021 MACRO 02000021 &L HDATA 03000021 .*A000000-999999 S21014 03050021 AIF ('&L' EQ '').HDAL 04000021 &L DSECT , HOOK DEPENDENT DATA AREA 05000021 AGO .HDAN 06000021 .HDAL ANOP 07000021 HDATA DSECT , HOOK DEPENDENT DATA AREA 08000021 .HDAN ANOP 09000021 ISMSCSAV DS 16F AREA FOR SVC REGS 10000021 ISMPKSAV DS 16F AREA FOR PI REGS 11000021 CATHSAVE DS 15F PLACE TO MOVE CATSAVE REGS 12000021 SERVSAVE DS 15F SERVICES SAVE AREA 13000021 OPSWSAV DS 0CL16 OLD PSW'S AT HOOK 14000021 SCPSWSAV DS DL8 SVC OLD PSW AT HOOK 15000021 PIPSWSAV DS DL8 PI OLD PSW AT HOOK 16000021 SYSBRSAV DS 15F SAVE AREA FOR SERVICES 17000021 APPLSAV DS 18F APPLICATION SAVE AREA 18000021 BRHKPSW DS DL8 PSW AT HOOK IF TYPE =S 19000021 CRTEMP DS F RESERVED 20000021 TEMPREC DS CL20 TEMP RECORD AREA USED BY STACK 21000021 HDAFLG1 DS XL1 FLAGS FOR SERVICES 22000021 STFLAG EQU 128 STACK SERVICES INCTL 23000021 DEFLAG EQU 64 DIS-,ENABLE INCTL 24000021 SMFLAG EQU 32 SETCMASK SERVICE INCTL 25000021 TMFLAG EQU 16 N-,ATERM SERVICES INCTL 26000021 FBFLAG EQU 8 FEOB INCTL 27000021 HDAFLG2 DS XL1 MORE FLAGS 28000021 POSTFLG EQU 128 POST NEEDED 29000021 TRUNCFLG EQU 64 RECORD WAS TRUNCATED 30000021 DS XL1 RESERVED 31000021 DS XL1 RESERVED 32000021 CLOCKIN DS 0CL8 ENTRY TIME STAMP 33000021 DS CL4 EXTENSION 34000021 CLOCK4 DS CL4 FOUR BYTE TIME STAMP 35000021 CLOCKOUT DS CL8 TERMINAL TIME STAMP 36000021 MEND , */ 37000021 * %DCLHDA: ; 38000021 * DCL 1 HDATA BASED(RCBHDATA), 39000021 * 2 HOOKREGS, /* SVC & PI REGS AT HOOK*/ 40000021 * 3 ISMSCSAV, /* IEASCSAV AT HOOK */ 41000021 * 4 ISMSCREG(16) PTR(31), /* STORED 0-15 */ 42000021 * 3 ISMPKSAV, /* IEAPKSAV AT HOOK */ 43000021 * 4 ISMPKREG(16) PTR(31), /* STORED 0-15 */ 44000021 * 2 CATHSAVE, /* PLACE TO MOVE CATSAVE*/ 45000021 * 3 CATHREGS(15), /* IN FUTURE */ 46000021 * 2 SERVSAVE, /* SERVICES SAVE AREA */ 47000021 * 3 SERVREGS(15), /* STORED 0-14 */ 48000021 * 2 OPSWSAV, /* OLD PSW'S AT HOOK */ 49000021 * 3 SCPSWSAV CHAR(8), /* SVC OPSW AT HOOK */ 50000021 * 3 PIPSWSAV CHAR(8), /* SVC */ 51000021 * 2 SYSBRSAV, /*SAVE AREA FOR SERVICES*/ 52000021 * 3 SYSBRREG(15) PTR(31), 53000021 * 2 APPLSAV, /* APPLICATION SAVE AREA*/ 54000021 * 3 APPLREG(18), 55000021 * 2 BRHKPSW CHAR(8) BDY(WORD), /*PSW AT HOOK IF TYPE=S */ 56000021 2 CRTEMP PTR(32), /* RESERVED */ 57000021 * 2 TEMPREC CHAR(20), /*USED BY STACK TO BUILD*/ 58000021 * /* HEADER RECORD. */ 59000021 * 2 HDAFLG1 BIT(8), /* FLAGS FOR SERVICES */ 60000021 * 3 STFLAG BIT(1), /* STACK,-S,-W IS INCTL */ 61000021 * 3 DEFLAG BIT(1), /* DIS-,ENABLE IS INCTL */ 62000021 * 3 SMFLAG BIT(1), /* SETCMASK IS INCTL */ 63000021 * 3 TMFLAG BIT(1), /* N-,ATERM IS INCTL */ 64000021 * 3 FBFLAG BIT(1), /* FEOB IS INCTL */ 65000021 * 2 HDAFLG2 BIT(8), /* MORE SERVICE FLAGS */ 66000021 * 3 POSTFLG BIT(1), /* POST IS NEEDED */ 67000021 * 3 TRUNCFLG BIT(1), /* RECORD WAS TRUNCATED */ 68000021 2 * CHAR(1), /* RESERVED */ 69000021 * 2 * CHAR(1), /* RESERVED */ 70000021 * 2 CLOCKIN CHAR(8) BDY(WORD), /*ENTRY TIMESTAMP. */ 71000021 * 3 * PTR(32) BDY(WORD), 72000021 * 3 CLOCK4 PTR(32) BDY(WORD), 73000021 * 2 CLOCKOUT CHAR(8) BDY(WORD); /*TERMINAL TIMESTAMP */ 74000021 ./ ADD SSI=01012008,SOURCE=1,NAME=HEXCNVT MACRO 00500020 &NAME HEXCNVT &OUT,&IN,&LN 01000020 GBLC &HEXSECT,&HEXTAB,&HEXWRD 01500020 LCLA &A,&B,&C,&D,&E,&F,&G 02000020 LCLB ®SW,&RLNSW,&DFALTSW 02500020 LCLB &HEXSW 03000020 LCLC &GNAME 03500020 &GNAME SETC 'HEX'.'&SYSNDX' 04000020 &DFALTSW SETB (T'&LN EQ 'O') 04500020 AIF (&DFALTSW EQ 1).NEXT2 05000020 &RLNSW SETB ('&LN'(1,1) EQ '(') 05500020 .NEXT2 AIF ('&OUT' EQ '' OR '&IN' EQ '').ERROR2 06000020 ®SW SETB ('&OUT'(1,1) EQ '(') 06500020 AIF (&DFALTSW EQ 0 AND T'&LN NE 'N').ERROR4 07000020 AIF (&DFALTSW EQ 1).NEXT3 07500020 AIF (N'&LN NE 1).ERROR5 08000020 .NEXT3 AIF (&RLNSW EQ 1 AND T'&LN(1) NE 'N').ERROR4 LN MUST BE C08500020 SELF DEFINING 09000020 AIF (&DFALTSW EQ 1).NEXT4 09500020 AIF (&RLNSW EQ 1 AND (&LN(1) LT 2 OR &LN(1) GT 12)).ERROR3 C10000020 IF LN IS A REG IT MUST BE 2-12 10500020 AIF (&RLNSW EQ 0 AND T'&LN(1) NE 'N').ERROR4 LN MUST BE X11000020 SELF DEFINING 11500020 AIF (&RLNSW EQ 1).NEXT4 12000020 AIF (&LN LT 1 OR &LN GT 112).ERROR6 LN MUST BE FROM 1-112 12500020 .NEXT4 AIF (®SW EQ 0).NEXT9 13000020 AIF ('&IN'(1,1) NE '(').ERROR1 &IN MUST ALSO BE A REG 13500020 AIF (T'&OUT NE 'N').ERROR4 14000020 AIF (N'&OUT GT 1).ERROR3 14500020 AIF (&OUT(1) LE 1 OR &OUT(1) GT 12).ERROR3 15000020 AIF (T'&IN NE 'N').ERROR4 15500020 AIF (N'&IN GT 1).ERROR3 16000020 AIF (&IN(1) LE 1 OR &IN(1) GT 12).ERROR3 16500020 AGO .NEXT5 17000020 .NEXT9 AIF ('&IN'(1,1) EQ '(').ERROR1 17500020 AIF (T'&OUT EQ 'N' OR T'&IN EQ 'N').ERROR4 18000020 .NEXT5 ANOP 18500020 &HEXSW SETB ('&HEXSECT' EQ '&SYSECT') 19000020 AIF (&HEXSW EQ 1).NEXT6 19500020 &HEXSECT SETC '&SYSECT' 20000020 &HEXWRD SETC '&GNAME' 20500020 &HEXTAB SETC '&GNAME.A' 21000020 .NEXT6 ANOP 21500020 AIF (&DFALTSW EQ 1).DFALT 22000020 AIF (&RLNSW EQ 1).REGLN 22500020 AIF (&LN GT 7).MULTI 23000020 &A SETA &LN*2+1 LENGTH FOR R1 OF UNPK 23500020 &B SETA &LN+1 LENGTH FOR R2 OF UNPK 24000020 .CONTA AIF (®SW EQ 1).ISAREG 24500020 &NAME UNPK &OUT.(&A),&IN.(&B) UNPACK HEX DIGITS 25000020 &A SETA &A-1 25500020 MVI &OUT+&A,X'40' CLEAR SIGN BYTE 26000020 .CONTB L 1,&GNAME.B SET ORIGIN OF TABLE 26500020 S 1,0(1) BACK 240 BYTES 27000020 AIF (&RLNSW EQ 1).CONTG 27500020 AIF (®SW EQ 1).CONTD 28000020 TR &OUT.(&A),0(1) TRANSLATE FA-FF 28500020 .CONTC B &GNAME.H BR AROUND CONSTANTS 29000020 AIF (&HEXSW EQ 1).ENDD DON'T GENERATE TABLE IF SW ON 29500020 AGO .ENDC 30000020 .ISAREG ANOP 30500020 &NAME UNPK 0(&A,&OUT(1)),0(&B,&IN(1)) UNPACK HEX DIGITS 31000020 &A SETA &A-1 31500020 MVI &A.(&OUT(1)),X'40' CLEAR SIGN BYTE 32000020 AGO .CONTB SET REG 1 FOR TR 32500020 .CONTD TR 0(&A,&OUT(1)),0(1) TRANSLATE FA-FF 33000020 AGO .CONTC 33500020 .DFALT ANOP 34000020 &A SETA 9 DFAULT TO 4 BYTES 34500020 &B SETA 5 35000020 AGO .CONTA 35500020 .MULTI ANOP 36000020 &C SETA (&LN/4) TO UNPACK 4 AT A TIME 36500020 &D SETA &LN-&C*4 REMAINDER 37000020 &A SETA 9 37500020 &B SETA 5 38000020 AIF (®SW EQ 0).MULTIB 38500020 &E SETA &OUT(1) 39000020 &F SETA &IN(1) 39500020 &G SETA 1 40000020 &NAME LA &G,&C SET COUNT 40500020 .MULTIA ANOP 41000020 &GNAME.E UNPK 0(&A,&E),0(&B,&F) UNPACK HEX DIGITS 41500020 &A SETA &A-1 42000020 MVI &A.(&E),X'EF' CLEAR SIGN BYTE 42500020 LA &E,9(&E) INCREMENT ADDRESSES 43000020 LA &F,4(&F) 43500020 BCT &G,&GNAME.E LOOP 44000020 AIF (&D EQ 0).CONTH NO REMAINDER 44500020 &A SETA &D*2+1 45000020 &B SETA &D+1 45500020 UNPK 0(&A,&E),0(&B,&F) UNPACK HEX DIGITS 46000020 &A SETA &A-1 46500020 MVI &A.(&E),X'40' CLEAR SIGN BYTE 47000020 .CONTH ANOP 47500020 &C SETA &C+&LN*2 48000020 &G SETA &C+&D*2 LENGTH OF FIELD TO BE TRANSLATED 48500020 LA 1,&C RE-ESTABLISH BEGINING 49000020 SR &E,1 OF FIELD 49500020 L 1,&GNAME.B SET ORIGIN OF TABLE 50000020 S 1,0(1) BACK 240 BYTES 50500020 TR 0(&G,&E),0(1) TRANSLATE FA-FF 51000020 AGO .CONTC 51500020 .MULTIB ANOP 52000020 &NAME LA 2,&OUT 52500020 LA 1,&IN 53000020 LA 3,&C SET COUNT 53500020 &E SETA 2 54000020 &F SETA 1 54500020 &G SETA 3 55000020 AGO .MULTIA 55500020 .REGLN ANOP 56000020 AIF (®SW EQ 0).CONTI 56500020 &E SETA &OUT(1) 57000020 &F SETA &IN(1) 57500020 AGO .CONTJ 58000020 .CONTI ANOP 58500020 &E SETA 2 59000020 &F SETA 3 59500020 &NAME LA 2,&OUT 60000020 LA 3,&IN 60500020 LR 1,&LN(1) 61000020 AGO .CONTK 61500020 .CONTJ ANOP 62000020 &NAME LTR 1,&LN(1) LOAD LN TO REG 1 AND TEST 62500020 BZ &GNAME.H DO NOTHING IF ZERO 63000020 .CONTK LA 0,3 SET UP MASK 63500020 NR 0,1 AND SAVE 2 LOW ORDER BITS 64000020 SRL 1,2 DIVIDE BY 4 64500020 LTR 1,1 LENGTH LESS THAN 4 65000020 BZ &GNAME.F IF YES--BRANCH 65500020 &GNAME.E UNPK 0(9,&E),0(5,&F) UNPACK HEX DIGITS 66000020 MVI 8(&E),X'EF' CLEAR SIGN BYTE 66500020 LA &E,9(&E) INCREMENT REGS 67000020 LA &F,4(&F) 67500020 BCT 1,&GNAME.E LOOP 68000020 &GNAME.F LTR 0,0 68500020 BZ &GNAME.G BRANCH IF SAVED BITS ARE 0 69000020 LR 1,0 ADJUST REG 1 69500020 AR 1,0 FOR EXECUTE INSTRUCTION 70000020 SLL 1,4 70500020 OR 1,0 71000020 EX 1,&GNAME.C EXECUTE UNPK 71500020 SRL 1,4 72000020 AR &E,1 72500020 MVI 0(&E),X'40' CLEAR SIGN BYTE 73000020 &GNAME.G LR 1,&LN(1) 73500020 SRL 1,2 DIVIDE BY 4 74000020 AR &LN(1),&LN(1) SET UP LENGTH FOR 74500020 AR &LN(1),1 TRANSLATE INSTRUCTION 75000020 SR &E,&LN(1) RE-ESTABLISH BEGINING OF FIELD 75500020 AGO .CONTB SET REG 1 FOR TR 76000020 .CONTG BCTR &LN(1),0 DECR LN 1 FOR EXECUTE INST 76500020 EX &LN(1),&GNAME.D EXECUTE TR 77000020 B &GNAME.H BRANCH AROUND CONSTANTS 77500020 AGO .ENDA 78000020 .ERROR1 MNOTE 12,'INCONSISTANT PARAMETERS' 78500020 MEXIT 79000020 .ERROR2 MNOTE 12,'PARAMETER MISSING' 79500020 MEXIT 80000020 .ERROR3 MNOTE 12,'REG PARMS CANNOT BE 0, 1, OR 13 THROUGH 15' 80500020 MEXIT 81000020 .ERROR4 MNOTE 12,'INVALID TYPE ATTRIBUTE SPECIFIED IN PARAMETERS' 81500020 MEXIT 82000020 .ERROR5 MNOTE 12,'&LN--MULTIPLE PARAMETERS INVALID' 82500020 MEXIT 83000020 .ERROR6 MNOTE 12,'&LN INVALID--MUST BE FROM 1-112' 83500020 MEXIT 84000020 .ENDA ANOP 84500020 &GNAME.C UNPK 0(0,&E),0(0,&F) UNPACK HEX DIGITS 85000020 &GNAME.D TR 0(0,&E),0(1) TRANSLATE FA-FF 85500020 AIF (&HEXSW EQ 0).ENDC 86000020 .ENDD ANOP 86500020 &GNAME.B DC A(&HEXWRD) 87000020 AGO .ENDB 87500020 .ENDC ANOP 88000020 &GNAME.B DC A(&HEXWRD) 88500020 &GNAME DC F'234' 89000020 DC C' ' 89500020 &GNAME.A DC C'0123456789ABCDEF' 90000020 .ENDB ANOP 90500020 &GNAME.H DS 0H 91000020 MEND 91500020 ./ ADD SSI=40810755,NAME=HMASMCCA,SOURCE=1 /********************************************************************/ 01000001 /* SMP COMMON COMMUNICATIONS AREA */ 02000001 /********************************************************************/ 03000001 DECLARE 04000001 %IF CCADSECT='NO' 05000001 %THEN 06000001 %GOTO CCANODST; 07000001 1 HMASMCCA BASED(CCAPTR) BDY(WORD), 08000001 %GOTO CCACONTN; 09000001 %CCANODST:; 10000001 1 HMASMCCA BDY(WORD), 11000001 %CCACONTN:; 12000001 3 CCAID CHAR(4), /* EYE-CATCHER BYTES */ 13000001 3 CCABUFAD PTR(31), /* ADDRESS OF BLOCK BUFFER */ 14000001 3 CCAIOPTR PTR(31), /* ADDRESS OF THE IOP */ 15000001 3 CCAICT PTR(31), /* ADDRESS OF THE ICT */ 16000001 3 CCAICPTF PTR(31), /* ADDR OF ICT PTF TABLE */ 17000001 3 CCAICMOD PTR(31), /* ADDRESS OF ICT MODULE TABLE */ 18000001 3 CCAICLMD PTR(31), /* ADDR OF ICT LOAD MODULE TABLE*/ 19000001 3 CCAPESIZ PTR(31), /* SIZE OF THE IOP */ 20000001 3 CCALKED PTR(31), /* ADDRESS OF LKED BLDL */ 21000001 3 CCAASM PTR(31), /* ADDRESS OF ASSEMBLER BLDL */ 22000001 3 CCACOPY PTR(31), /* ADDRESS OF IEBCOPY BLDL */ 23000001 3 CCASPZAP PTR(31), /* ADDRESS OF S/ZAP BLDL */ 24000001 3 CCAIOSUP PTR(31), /* ADDRESS OF IEHIOSUP BLDL */ 25000001 3 CCAUPDTE PTR(31), /* ADDRESS OF IEBUPDTE BLDL */ 26000001 3 CCALKSIZ PTR(31), /* LKED SIZE PARM LIST */ 27000001 3 CCAJFCDS PTR(31), /* ADDR OF JFCB FOR CDS */ 28000001 3 CCAJFPTS PTR(31), /* ADDR OF JFCB FOR PTS */ 29000001 3 CCAMXERR FIXED(15), /* MAXIMUM NUMBER PTF TAPE ERRS */ 30000001 3 CCAPEMAX FIXED(15), /* MAX NUMBER LIST ELEMENTS */ 31000001 3 CCABFMMX FIXED(15), /* MAX NUM OF RECS IN MACRO BLK */ 32000001 3 CCABFPMX FIXED(15), /* MAX NUM OF RECS IN PTS BLK */ 33000001 3 CCAOPT BIT(8), /* SMP OPTION BITS */ 34000001 5 CCALKOPT BIT(1), /* COMPLETE ALL LKED IN 1 PASS */ 35000001 5 CCACPOPT BIT(1), /* COMPLETE COPIES IN 1 PASS */ 36000001 5 * BIT(6), /* UNUSED AT THIS TIME */ 37000001 3 CCAFLAG1 BIT(8), /* CURRENT SMP VERB */ 38000001 5 CCAREC BIT(1), /* RECEIVE MODE */ 39000001 5 CCAAPPLY BIT(1), /* APPLY MODE */ 40000001 5 CCAACCPT BIT(1), /* ACCEPT MODE */ 41000001 5 CCAREJ BIT(1), /* REJECT MODE */ 42000001 5 CCARES BIT(1), /* RESTORE MODE */ 43000001 5 CCAUPDJ BIT(1), /* UPDATE CDS JCL MODE */ 44000001 5 CCAUPDU BIT(1), /* UPDATE CDS UCL MODE */ 45000001 5 CCALSLOG BIT(1), /* LIST LOG MODE */ 46000001 3 CCAFLAG2 BIT(8), /* CURRENT SMP VERB CONTINUED */ 47000001 5 CCALSCDS BIT(1), /* LIST CDS MODE */ 48000001 5 CCANCPTF BIT(1), /* PTF TO NUCLEUS FOUND */ 49000001 5 CCACPYCP BIT(1), /* LKED/COPY COMPLETE INDICATOR */ 50000001 5 CCATSO BIT(1), /* TSO INDIC FOR IEHIOSUP */ 51000001 5 CCASVCLB BIT(1), /* SVCLIB AFFECTED - RUN IOSUP */ 52000001 5 CCATERM BIT(1), /* TERMINATE SMP AT END OF VERB */ 53000001 5 CCAICSB BIT(1), /* INCORE STOW/BLDL IN PROCESS */ 54000001 5 * BIT(1), /* UNUSED */ 55000001 3 CCAFLAG3 BIT(8), /* SMP FLAGS 3 */ 56000001 5 CCAZAPP BIT(1), /* S/ZAPS ARE PRESENT */ 57000001 5 CCALINKP BIT(1), /* LINK EDITS ARE PRESENT */ 58000001 5 CCACOPYP BIT(1), /* COPIES ARE PRESENT */ 59000001 5 * BIT(5), /* UNUSED */ 60000001 3 CCANUCID CHAR(1), /* DEFAULT NUCLEUS ID CHARACTER */ 61000001 3 CCASREL CHAR(4), /* SYSTEM/RELEASE INFORMATION */ 62000001 3 CCADATE CHAR(3), /* CURRENT DATE */ 63000001 3 CCASPDCB PTR(31), /* DCB ADDR FOR IOSUP LINK */ 63050001 3 CCABLKSZ FIXED(15); /* SIZE OF BLOCK BUFFER */ 63100001 ./ ADD SSI=42050044,NAME=HMASMICT,SOURCE=1 /********************************************************************/ 00800001 * /* */ 01600001 * /* MAPPING MACRO FOR THE SMP ICT (IN CORE CDS ) */ 02400001 * /* THIS MACRO IS USED BY THE LINKEDIT, COPY AND SUPERZAP */ 03200001 * /* INVOKING ROUTINES TO CONTROL ACCESS TO SYSTEM LIBRARIES. */ 04000001 * /* */ 04800001 * /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 05600001 * /* THE ICT CONTAINS THREE VARIABLE LENGTH SECTIONS- THE PTF */ 06400001 * /* SECTION, THE MODULE SECTION AND THE LOAD MODULE SECTION. EACH */ 07200001 * /* SECTION IS BASED ON ITS ASSOCIATED POINTER IN THE COMMON */ 08000001 * /* AREA (HMASMCCA). */ 08800001 /* */ 09600001 * /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 10400001 * /* ICTIXPF, ICTIXMF AND ICTIXLF HAVE BEEN BASED ON ITS ASSOCIATED */ 11200001 * /* CHAIN POINTER WITH A SUBSCRIPT OF 1. THIS SUBSCRIPT MAY HAVE TO*/ 12000001 * /* BE CHANGED TO SOME INDEX VARIABLE DEPENDING UPON USAGE. THIS */ 12800001 * /* MAY BE ACCOMPLISHED THROUGH USE OF THE RESPECIFY CLAUSE. */ 13600001 /********************************************************************/ 14400001 * DECLARE 15200001 * 1 HMASMICT BASED(CCAICT), /* SMP ICT */ 16000001 * 2 ICTCORE, 16800001 * 4 ICTSPLEN BIN(32), /* SUBPOOL AND LENGTH OF GOTTEN CORE */ 17600001 * 6 ICTSP BIN(8), /* SUBPOOL */ 18400001 * 6 ICTLEN BIN(24)BDY(BYTE), /* LENGTH OF GOTTEN CORE */ 19200001 * 1 ICTPTF(*)BASED(CCAICPTF), /* PTF SECTION OF ICT */ 20000001 * 2 ICTPTFS CHAR(7), /* PTF OR MODIFICATION NO. */ 20800001 * 4 ICTPMID CHAR(2), /* TWO BYTE MODIFICATION IDENTIFIER */ 21600001 6 ICTPEND BIN(16)BDY(BYTE), /*USED TO INDICATE END OF PTF 22400001 SECTION OF THE ICT. */ 23200001 * 4 ICTPNO CHAR(5), /* PTF OR MODIFICATION NUMBER */ 24000001 * 2 ICTPFLG1 BIT(8), /* PTF CDS FLAGS */ 24800001 * 6 ICTAPP BIT(1), /* PTF APPLIED */ 26400001 * 6 ICTACC BIT(1), /* PTF ACCEPTED */ 27200001 6 ICTFREC BIT(1), /* THIS PTF FORCE RECEIVED */ 28000001 * 6 ICTDUMMP BIT(1), /* DUMMY PTF FROM SUPERCEEDS */ 28800001 * 6 ICTREGEN BIT(1), /* PTF DEFAULT APPLIED VIA 29000002 SYSTEM REGEN @VS05296*/ 29200002 * 6 * BIT(3), /* RESERVED */ 29600002 * 2 ICTPIFLG BIT(8), /* PTF SECTION INTERNAL FLAGS */ 30400001 6 * BIT(1), /* RESERVED */ 31200001 6 ICTPMAC BIT(1), /* PTF CONTAINS MACROS */ 32000001 * 6 ICTZAP BIT(1), /* PTF CONTAINS A SUPERZAP */ 32800001 6 ICTPROCS BIT(1), /* THIS PTF BEING PROCESSED */ 33600001 6 ICTFORCE BIT(1), /* THIS PTF BEING FORCED */ 34400001 * 6 ICTPNOGO BIT(1), /* PTF SECTION NOGO FLAG */ 35200001 * 6 ICTPLNK BIT(1), /* DO NOT LINK THIS PTF - LIB=NONE */ 36000001 * 6 ICTPCPL BIT(1), /* PTF COMPLETE */ 36800001 * 2 ICTPCHN PTR(24)BDY(BYTE); /* CHAIN POINTER TO INDEX EXTENSION */ 37600001 * DECLARE 38400001 1 ICTIXPF(*)BDY(HWORD)BASED(ICTPCHN(1)), /* INDICES INTO EXTENSION */ 39200001 2 ICTIXP PTR(16)BDY(HWORD); /* INDEX ENTRIES FOR PTF SECTION */ 40000001 * /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 40800001 * /* */ 41600001 * /* MODULE SECTION OF ICT */ 42400001 * /* */ 43200001 * /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 44000001 * DECLARE 44800001 * 1 ICTMOD(*)BASED(CCAICMOD), /* MODULE SECTION OF ICT */ 45600001 * 2 ICTMNAME CHAR(8), /* MODULE NAME */ 46400001 4 ICTMEND BIN(16)BDY(BYTE), /* USED TO INDICATE END OF MODULE SECT.*/ 47200001 * 2 ICTMFLG1 BIT(8), /* CDS MODULE FLAGS */ 48000001 * 4 ICTLIBLK BIT(1), /* CRLIB LOADMODULE */ 48800001 * 4 ICTLIBTX BIT(1), /* CRLIB TEXT - MUST LINK */ 49600001 * 4 ICTMALIS BIT(1), /* MODULE HAS ALIAS ENTRIES */ 50400001 4 ICTMXPND BIT(1), /*MODULE IS TO BE EXPANDED @OY04018*/ 50800002 4 ICTMPRMS BIT(1), /*MODULE LINK PARMS OBTAINED @VS08700*/ 51000002 * 4 * BIT(3), /* RESERVED */ 51200002 * 2 ICTMIFLG BIT(8), /* MODULE SECTION INTERNAL FLAGS */ 52000001 * 4 ICTMPROC BIT(1), /* MODULE IN PROCESS */ 52800001 * 4 ICTMMAC BIT(1), /* MODULE IS MACRO ASSEMBLY */ 53600001 * 4 ICTMZAP BIT(1), /* THIS MODULE CONTAINS A SUPERZAP */ 54400001 * 4 ICTNOM BIT(1), /* MODULE NOT FOUND */ 55200001 * 4 ICTMIS BIT(1), /* MODIFICATION MISMATCH */ 56000001 * 4 ICTMNOGO BIT(1), /* MODULE SECTION NOGO SWITCH */ 56800001 4 ICTCRLIB BIT(1), /* CRLIB IS PRESENT */ 57600001 4 ICTMCPL BIT(1), /* COMPLETION BIT */ 58400001 2 ICTMLEPR BIT(8), /* LINK EDIT PARMS FOR THIS MODULE */ 58450001 2 ICTMID CHAR(2), /* MODIFICATION IDENTIFIER */ 59200001 2 ICTFMLIB CHAR(8), /* FROMLIB */ 60000001 * 2 ICTPPTR PTR(16)BDY(BYTE), /* POINTER TO PTF ENTRY */ 60800001 * 2 ICTMCHN PTR(24)BDY(BYTE); /* CHAIN POINTER TO INDEX EXTENSION */ 61600001 * DECLARE 62400001 1 ICTIXMF(*)BDY(HWORD)BASED(ICTMCHN(1)), /* INDICES INTO LOAD MODULE*/ 63200001 2 ICTIXM PTR(16)BDY(HWORD); /* INDEX ENTRIES MODULE SECTION */ 64000001 /********************************************************************/ 64800001 * /* */ 65600001 * /* LOAD MODULE SECTION OF ICT. */ 66400001 * /* */ 67200001 * /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 68000001 * DECLARE 68800001 * 1 ICTLMOD(*)BASED(CCAICLMD), /* LOAD MODULE SECTION OF ICT */ 69600001 * 2 ICTLMNAM CHAR(8), /* LOAD MODULE NAME */ 70400001 4 ICTLEND BIN(16)BDY(BYTE), /* USED TO INDICATE END OF LOAD MOD. */ 71200001 * 2 ICTLFLG1 BIT(8), /* FIRST BYTE CDS LOAD MOD. FLAGS */ 72000001 * 4 ICTAPF BIT(1), /* APF PARM, AC=1 @VS08700*/ 72800002 * 4 ICTRENT BIT(1), /* RE-ENTRANT */ 73600001 * 4 ICTREUS BIT(1), /* REUSABLE */ 74400001 * 4 ICTSCTR BIT(1), /* SCATTER LOAD */ 75200001 * 4 ICTOVLY BIT(1), /* OVERLAY STRUCTURE */ 76000001 * 4 ICTREFR BIT(1), /* REFRESHABLE */ 76800001 * 4 ICTDC BIT(1), /* DOWNWARD COMPATABLE */ 77600001 * 4 ICTNE BIT(1), /* NOT EDITABLE */ 78400001 * 2 ICTLFLG2 BIT(8), /* SECOND BYTE CDS LOAD MOD FLAGS */ 79200001 * 4 ICTCOPY BIT(1), /* COPIED AT SYSGEN */ 80000001 * 4 ICTLINK BIT(1), /* LINKEDIT PARMS OBTAINED */ 80800001 * 4 * BIT(6), /* RESERVED */ 81600002 * 2 ICTLIFLG BIT(8), /* LOAD MOD SECTION INTERNAL FLAGS */ 82400001 * 4 ICTTGIND BIT(2), /* TARGET LIBRARY INDICATOR BITS */ 83200001 /* THESE BITS ARE SET BY TABLE BUILD IF A TARGET EXISTS */ 84000001 * 6 ICTTIND1 BIT(1), /* TARGET LIBRARY 1 INDICATOR */ 84800001 * 6 ICTTIND2 BIT(1), /* TARGET LIBRARY 2 INDICATOR */ 85600001 * 4 ICTINCLD BIT(1), /* LOAD MODULE INCLUDED (LKI) */ 86400001 * 4 ICTLXPND BIT(1), /* LMOD HAS MOD TO BE EXPANDED @OY04018*/ 86800002 * 4 ICTLALIS BIT(1), /* MODULE CONTAINS ALIAS ENTRIES */ 88000001 * 4 ICTLPROC BIT(1), /* LOAD MODULE IN PROCESS */ 88800001 * 4 ICTLNOGO BIT(1), /* LOAD MODULE NOGO FLAG */ 89600001 * 4 ICTLCPL BIT(1), /* LOAD MODULE COMPLETE */ 90400001 * 2 ICTTGLIB CHAR(16), /* TARGET LIBRARIES */ 91200001 * 4 ICTTG1 CHAR(8), /* TARGET LIBRARY # 1 . */ 92000001 * 4 ICTTG2 CHAR(8), /* TARGET LIBRARY # 2 OR BLANKS */ 92800001 * 2 ICTLTTR BIN(24)BDY(BYTE), /* TTR OF EXTENDED DIRECTORY */ 93600001 * 2 ICTLCHN PTR(24)BDY(BYTE); /* CHAIN POINTER INDEX EXTENSION */ 94400001 * DECLARE 95200001 1 ICTIXLF(*)BDY(HWORD)BASED(ICTLCHN(1)), /* INDICES TO MODULES */ 96000001 2 ICTIXL PTR(16)BDY(HWORD); /* INDEX ENTRIES LOAD MOD SECTION */ 96800001 ./ ADD SSI=42050045,NAME=HMASMIOP,SOURCE=1 * /*****************************************************************/ 00300001 * /* */ 00600001 * /* MAPPING MACRO FOR THE SMP IOP (INPUT/OUTPUT PARM LIST) */ 00900001 * /* */ 01200001 * /*****************************************************************/ 01500001 * /* THIS MACRO IS USED FOR ALL CALLS TO THE SMP INPUT/OUTPUT */ 01800001 * /* ROUTINE (HMASMIO). SEQUENTIAL DATA SETS CAN BE ACCESSED */ 02100001 * /* BY MERELY INDICATING THE DATA SET ID (IOPDSID) AND THE TYPE */ 02400001 * /* OF OPERATION (IOPFUNCT). THE FIELD IOPBUFAD SHOULD POINT AT */ 02700001 * /* THE BUFFER. FOR PARTITIONED DATA SETS, THE FIELDS FROM */ 03000001 * /* IOPNAME TO THE END ARE USED TO DESCRIBE THE DIRECTORY ENTRY */ 03300001 * /* FORMAT. */ 03600001 * /* FOR ALL OPERATIONS, OPEN IS IMPLIED. */ 03900001 * /*****************************************************************/ 04200001 * %IF DSECT = 'NO' 04500001 * %THEN %GOTO IOPNODST; 04800001 * DECLARE 05100001 * 1 HMASMIOP BASED(IOPPTR) BDY(WORD), /* SMP I/O AREA MAPPING */ 05400001 * %GOTO IOPCONT; 05700001 * %IOPNODST:; 06000001 * DECLARE 06300001 * 1 HMASMIOP BDY(WORD), /* SMP I/O AREA MAPPING */ 06600001 * %IOPCONT:; 06900001 * 2 IOPDSID FIXED(8), /* DATA SET ID ****************** 07200001 * ALLOWABLE VARIABLES ARE - 07500001 * IOPCDSDR - CDS DIRECTORY ***** 07800001 * IOPCDSM - CONTROL DS MAIN **** 08100001 * IOPCDSA - CONTROL DS ALT ***** 08150001 * IOPPTS - PTF TEMPORARY STORE * 08400001 * IOPPRINT - PRINTER *********** 08700001 * IOPHLDS - HISTORY LOG TAPE *** 09000001 * IOPSGTAP - SYSGEN TAPE ******* 09300001 * IOPMACL - MACRO LIBRARY ****** 09600001 * IOPSCR1 - SCRATCH DATA SET *** 09900001 * IOPSCR2 - SCRATCH DATA SET *** 10200001 * IOPPTFIN - PTF TAPE ********** 10500001 * IOPCONTR - CONTROL CARDS ***** */ 10800001 * 2 IOPFUNCT FIXED(8), /* I/O FUNCTION ***************** 11100001 * ALLOWABLE VARIABLES ******* 11400001 * IOPOPEN - OPEN OPERATION **** 11700001 * IOPREAD - READ OPERATION **** 12000001 * IOPWRITE - WRITE OPERATION ** 12300001 * IOPPOSI - POS (POINT-INPUT) * 12600001 * IOPPOSO - POS (POINT-OUTPUT) 12900001 * IOPCLOSE - CLOSE OPERATION ** 13200001 * IOPLOC - LOCATE (BLDL) OP *** 13500001 * IOPDLOC - LOCATE DISTLIB **** 13550001 * IOPSTOWC - STOW (CHANGE) OP * 13800001 * IOPSTOWD - STOW (DELETE) OP * 14100001 * IOPSTOWR - STOW (REPLACE) OP 14400001 * IOPUDEO - DIRECT UPDATE ONLY 14700001 * IOPCLOSA - CLOSE OPEN FILES */ 15000001 * 2 IOPRETRN PTR(8), /* RETURN CODE FROM I/O */ 15300001 * 2 IOPMACID PTR(8), /* MACRO LIB INDEX */ 15600001 * 2 IOPBUFAD PTR(31), /* BUFFER ADDRESS */ 15900001 * 2 IOPNAME CHAR(8), /* MODULE NAME */ 16200001 * 3 IOPTYPE CHAR(1), /* TYPE FIELD OF THE CDS */ 16500001 * 4 IOPCDTYP BIT(2), /* CDS TYPE OF ENTRY ******** 16800001 * COMPILE TIME VARIABLES - **** 17100001 * IOPCMOD - MODULE ENTRY ****** 17400001 * IOPCLMOD - LOAD MODULE ENTRY 17700001 * IOPCMAC - MACRO ENTRY ******* 18000001 * IOPCASM - ASSEMBLY ********** */ 18300001 * /* TO INDICATE ONE OF THE ABOVE 4 TYPES OF ENTRIES, */ 18600001 * /* PUT THE DESIRED NAME IN IOPNAME AND THEN SET IOPCDTYP EQUAL */ 18900001 * /* TO THE PROPER TYPE... */ 19200001 * /* IF THE ENTRY IS A DLIB, PTF, OR SYSTEM TYPE, THE FOLLOWING IS */ 19500001 * /* USED. */ 19800001 * /* PUT THE DLIB NAME OR PTF NUMBER IN IOPNAME2 AND SET IOPTYPE */ 20100001 * /* EQUAL TO EITHER IOPCPTF, IOPCDLIB, OR IOPCSYS. */ 20400001 * 3 IOPNAME2 CHAR(7), /* FIELD FOR PTF#, DLIB, SYSTEM */ 20700001 * 2 IOPTTR PTR(24) BDY(BYTE), /* TTR OF ENTRY */ 21000001 * 3 IOPBLKSI FIXED(15) BDY(BYTE), /* BLOCKSIZE FROM OPEN */ 21300001 * 2 IOPUSERL FIXED(8), /* LENGTH OF USER DATA */ 21600001 * 2 IOPUDATA CHAR(*); /* USER DATA */ 21900001 * /* THIS FIELD IS MAPPED BY THE FOLLOWING STRUCTURES FOR */ 22200001 * /* THE VARIOUS DIFFERENT TYPES OF CDS AND PTS ENTRIES. IT IS */ 22500001 * /* ALSO USED TO CONTAIN THE OLD AND NEW NAMES FOR A STOW */ 22800001 * /* RENAME (CHANGE) OPERATION. */ 23100001 * 23400001 * /*****************************************************************/ 23700001 * /* */ 24000001 * /* THE FOLLOWING CONSTANTS DEFINE THE DATA SETS (FOR IOPDSID) */ 24300001 * /* */ 24600001 * /*****************************************************************/ 24900001 * DECLARE 25200001 * IOPHLDS FIXED(8) CONSTANT (1); /* INDICATES HISTORY LOG */ 25500001 * DECLARE 25800001 * IOPCDSM FIXED(8) CONSTANT (2); /* INDICATES CDS MAIN */ 26100001 * DECLARE 26400001 * IOPSCR1 FIXED(8) CONSTANT(3); /* INDICATES SCRATCH DATA SET */ 26700001 * DECLARE 27000001 * IOPSCR2 FIXED(8) CONSTANT(4); /* INDICATES SCRATCH DATA SET */ 27300001 * DECLARE 27600001 * IOPMACL FIXED(8) CONSTANT(5); /* INDICATES MACRO LIBRARY */ 27900001 * DECLARE 28200001 * IOPPTS FIXED(8) CONSTANT(6); /* INDICATES PTS DATA SET */ 28500001 * DECLARE 28800001 * IOPSGTAP FIXED(8) CONSTANT(7); /* INDICATES SYSGEN TAPE */ 29100001 * DECLARE 29400001 * IOPCDSDR FIXED(8) CONSTANT(8); /* INDICATES CDS DIRECTORY */ 29700001 * DECLARE 30000001 * IOPCONTR FIXED(8) CONSTANT(9); /* INDICATES CONTROL CARD INP */ 30300001 * DECLARE 30600001 * IOPPTFIN FIXED(8) CONSTANT(10); /* INDICATES PTF INPUT FILE */ 30900001 * DECLARE 31200001 * IOPPRINT FIXED(8) CONSTANT(11); /* INDICATES PRINTER */ 31500001 * DECLARE 31550001 * IOPCDSA FIXED(8) CONSTANT(12); /* INDICATES ALTERNATE CDS */ 31600001 * 31800001 * /*****************************************************************/ 32100001 * /* */ 32400001 * /* THE FOLLOWING CONSTANTS DEFINE THE OPERATIONS (FOR IOPFUNCT) */ 32700001 * /* */ 33000001 * /*****************************************************************/ 33300001 * DECLARE 33600001 * IOPOPEN FIXED(8) CONSTANT(0); /* INDICATES OPEN OPERATION */ 33900001 * DECLARE 34200001 * IOPREAD FIXED(8) CONSTANT(1); /* INDICATES READ OPERATION */ 34500001 * DECLARE 34800001 * IOPPOSI FIXED(8) CONSTANT(2); /* INDICATES POSITION (INPUT) OP*/ 35100001 * DECLARE 35400001 * IOPLOC FIXED(8) CONSTANT(3); /* INDICATES LOCATE (BLDL) OP */ 35700001 * DECLARE 36000001 * IOPCLOSE FIXED(8) CONSTANT(4); /* INDICATES CLOSE OPERATION */ 36300001 * DECLARE 36600001 * IOPWRITE FIXED(8) CONSTANT(5); /* INDICATES WRITE OPERATION */ 36900001 * DECLARE 37200001 * IOPSTOWC FIXED(8) CONSTANT(6); /* INDICATES STOW CHANGE OP */ 37500001 * DECLARE 37800001 * IOPSTOWD FIXED(8) CONSTANT(7); /* INDICATES STOW DELETE OP */ 38100001 * DECLARE 38400001 * IOPSTOWR FIXED(8) CONSTANT(8); /* INDICATES STOW REPLACE OP */ 38700001 * DECLARE 39000001 * IOPPOSO FIXED(8) CONSTANT(9); /* INDICATES POSIT (OUTPUT) OP */ 39300001 * DECLARE 39600001 * IOPUDEO FIXED(8) CONSTANT(10); /* UPDATE DIRECTORY ENTRY ONLY */ 39900001 * DECLARE 40200001 * IOPCLOSA FIXED(8) CONSTANT(11); /* CLOSE ALL OPEN FILES */ 40500001 * DECLARE 40550001 * IOPDLOC FIXED(8) CONSTANT(12); /* LOCATE DISTLIB IN MACLIB */ 40600001 * 40800001 * /*****************************************************************/ 41100001 * /* */ 41400001 * /* THE FOLLOWING CONSTANTS DEFINE THE CDS TYPES OF ENTRIES */ 41700001 * /* */ 42000001 * /*****************************************************************/ 42300001 * DECLARE 42600001 * IOPCMOD BIT(2) CONSTANT('11'B); /* INDICATES MODULE TYPE */ 42900001 * DECLARE 43200001 * IOPCLMOD BIT(2) CONSTANT('01'B); /* INDICATES LOAD MOD TYPE */ 43500001 * DECLARE 43800001 * IOPCMAC BIT(2) CONSTANT('10'B); /* INDICATES MACRO TYPE */ 44100001 * DECLARE 44400001 * IOPCASM BIT(2) CONSTANT('00'B); /* INDICATES ASSEMBLY TYPE */ 44700001 * DECLARE 45000001 * IOPNORM BIT(2) CONSTANT('11'B); /* RETURN NAME TO NORMAL */ 45300001 * DECLARE 45600001 * IOPCDLIB CHAR(1) CONSTANT('0'); /* INDICATES DISTLIB ENTRY */ 45900001 * DECLARE 46200001 * IOPCSYS CHAR(1) CONSTANT('1'); /* INDICATES SYSTEM ENTRY */ 46500001 * DECLARE 46800001 * IOPCPTF CHAR(1) CONSTANT('9'); /* INDICATES PTF ENTRY */ 47100001 * 47400001 * /* IOPEOLST INDICATES END OF VARIABLE DATA */ 47700001 * /* THIS MUST BE INDICATED FOR CSECT, MACRO, DLIB, PTF, */ 48000001 * /* AND SYSTEM TYPE ENTRIES */ 48300001 * DECLARE 48600001 * IOPEOLST FIXED(8) CONSTANT(255); /* INDICATES END OF VAR LIST */ 48900001 * 49200001 * /* THE FOLLOWING MAPS THE CDS DATA FOR MODULES */ 49500001 * DECLARE 49800001 * 1 IOPMOCDS DEFINED(IOPUDATA), /* CDS DATA FOR MODULES */ 50100001 * 2 IOPMODID CHAR(2), /* MODULE MODIFIER ID */ 50400001 * 2 IOPDLIB CHAR(7), /* DISTRIBUTION LIBRARY */ 50700001 * 2 IOPLMODS(*) CHAR(8); /* LOAD MODULE NAME LIST */ 51000001 * 51300001 * /* THE FOLLOWING MAPS THE CDS DATA FOR LOAD MODULES */ 51600001 * DECLARE 51900001 * 1 IOPLMCDS DEFINED(IOPUDATA), /* CDS DATA FOR LOAD MODULES */ 52200001 * 2 IOPFLGS2 BIT(8), /* FLAGS */ 52500001 * 3 IOPAPF BIT(1), /* APF, AC=1 @VS08700*/ 52800002 * 3 IOPRENT BIT(1), /* RE-ENTRANT */ 53100001 * 3 IOPREUS BIT(1), /* REUSABLE */ 53400001 * 3 IOPSCTR BIT(1), /* SCATTER LOAD */ 53700001 * 3 IOPOVLY BIT(1), /* OVERLAY STRUCTURE */ 54000001 * 3 IOPREFR BIT(1), /* REFRESHABLE */ 54300001 * 3 IOPDC BIT(1), /* DOWNWARD COMPAT */ 54600001 * 3 IOPNE BIT(1), /* NOT EDITABLE */ 54900001 * 2 IOPFLGS3 BIT(8), /* FLAGS */ 55200001 * 3 IOPCOPY BIT(1), /* COPIED AT SYSGEN */ 55500001 * 3 IOPLINK BIT(1), /* LINK EDIT PARMS OBTAINED */ 55800001 * 3 IOPCHREP BIT(1), /* CHANGE/REPLACE CARDS OCCUR */ 56100001 * 3 * BIT(5), /* UNUSED */ 56400001 * 2 IOPSYSLB (3) CHAR(8); /* SYSTEM LIBRARY DDNAME(S) */ 56700001 * 57000001 * /* THE FOLLOWING MAPS THE CDS DATA FOR MACROS */ 57300001 * DECLARE 57600001 * 1 IOPMACDS DEFINED(IOPUDATA), /* CDS DATA FOR MACROS */ 57900001 * 2 * CHAR(2), /* MODIFICATION ID (IOPMODID) */ 58200001 * 2 IOPASMOD (*) CHAR(8); /* ASSEMBLY LIST */ 58500001 * 58800001 * /* ASSEMBLIES HAVE NO USER DATA */ 59100001 * 59400001 * /* THE FOLLOWING MAPS THE CDS DATA FOR PTFS */ 59700001 * DECLARE 60000001 * 1 IOPPTCDS DEFINED(IOPUDATA), /* CDS DATA FOR PTFS */ 60300001 * 2 IOPFLGS5 BIT(8), /* FLAGS */ 60600001 * 3 IOPSTAT BIT(5), /* PTF STATUS */ 60900002 * 4 IOPAPP BIT(1), /* PTF APPLIED */ 61200001 * 4 IOPACC BIT(1), /* PTF ACCEPTED */ 61500001 * 4 IOPFORCE BIT(1), /* FORCE RECEIVED PTF */ 61800001 * 4 IOPDUMMP BIT(1), /* DUMMY PTF FROM SUPERCEDES */ 62100001 * 4 IOPREGEN BIT(1), /* PTF DEFAULT APPLIED VIA 62200002 * SYSTEM REGEN */ 62300002 * 3 * BIT(3), /* UNUSED */ 62400002 * 2 IOPDATE CHAR(3), /* DATE PTF RECEIVED */ 62700001 * 2 IOPPNTRY (*) CHAR(9), /* MODULE/MACRO ENTRIES */ 63000001 * /* IF THIS IS A DUMMY PTF (CREATED FROM SUPERCEDES INFO), */ 63300001 * /* THEN THE MAJOR PTF NUMBER IS LOCATED IN IOPPMODS(1) */ 63600001 * 3 IOPPMODS CHAR(8), /* MODULE/MACRO AFFECTED */ 63900001 * 3 IOPPIND CHAR(1); /* TYPE (MOD, MAC, OR ZAP) */ 64200001 * /* CONSTANTS FOR IOPPIND FOLLOW */ 64500001 * DECLARE 64800001 * IOPPMACR FIXED(8) CONSTANT(0); /* INDICATES MACRO TYPE */ 65100001 * DECLARE 65400001 * IOPPMODU FIXED(8) CONSTANT(1); /* INDICATES MODULE TYPE */ 65700001 * DECLARE 66000001 * IOPPZAP FIXED(8) CONSTANT(2); /* INDICATES ZAP TYPE */ 66300001 * DECLARE 66400002 * IOPPXPD FIXED(8) CONSTANT(3);/*INDICATED EXPAND/ZAP TYPE*/ 66500002 * 66600001 * /* THE FOLLOWING MAPS THE CDS DATA FOR DISTRIBUTION LIBRARIES */ 66900001 * /* COPIED IN ENTIRETY AT SYSGEN. LIMIT FOR IOPDSYS IS 2, SET */ 67200001 * /* LAST MEMBER TO IOPEOLST */ 67500001 * DECLARE 67800001 * 1 IOPDLCDS DEFINED(IOPUDATA), /* CDS DATA FOR DLIBS */ 68100001 * 2 IOPDSYS(3) CHAR(8); /* SYSTEM LIBRARY(S) COPIED TO */ 68400001 * 68700001 * /* THE FOLLOWING MAPS THE CDS DATA FOR THE SYSTEM ENTRY */ 69000001 * DECLARE 69300001 * 1 IOPSYCDS DEFINED(IOPUDATA), /* CDS DATA FOR THE SYSTM ENTRY */ 69600001 * 2 IOPFLGS7 BIT(8), /* FLAGS - */ 69900001 * 3 IOPTSO BIT(1), /* THIS SYSTEM HAS TSO */ 70200001 * 3 * BIT(7), /* UNUSED */ 70500001 * 2 IOPSREL CHAR(4), /* SYSTEM AND RELEASE INDIC */ 70800001 * 2 IOPNUCID CHAR(1), /* DEFAULT NUCID FOR NUC UPDATES*/ 71100001 * 2 IOPPEMAX FIXED(15) BDY(BYTE), /* PTF ELEMENT MAX */ 71400001 * 2 IOPPDLM CHAR(1); /* DELIMITER FOR DIRECTORY */ 71700001 * 72000001 * /* THE FOLLOWING MAPS IOPUDATA FOR STOW (CHANGE) OPERATIONS */ 72300001 * DECLARE 72600001 * 1 IOPSTCMP DEFINED (IOPUDATA), /* STOWC MAP */ 72900001 * 2 IOPSTOLD CHAR(8), /* OLD MEMBER NAME */ 73200001 * 2 IOPSTNEW CHAR(8); /* NEW MEMBER NAME */ 73500001 * 73800001 * /* THE FOLLOWING MAPS THE PTS USER DATA FIELD */ 74100001 * DECLARE 74400001 * 1 IOPPTSNT DEFINED(IOPUDATA), /* PTS USER DATA ENTRY */ 74700001 * 2 IOPPFLG1 BIT(8), /* FLAGS */ 75000001 * 3 IOPLIBLK BIT(1), /* INDIRECT LINK LIBRARY MODULE */ 75300001 * 3 IOPLIBTX BIT(1), /* INDIRECT TEXT LIBRARY MODULE */ 75600001 * 3 IOPTALIS BIT(1), /* TARGET ALIASES FOLLOW */ 75900001 * 3 IOPDALIS BIT(1), /* DIST ALIASES FOLLOW */ 76200001 * 3 IOPLEFND BIT(1), /* LINK EDITOR PARMS FOUND */ 76250001 * 3 IOPXPND BIT(1), /*EXPAND REQUEST FOUND*/ 76500002 * 3 * BIT(2), /*UNUSED*/ 76520002 * 2 IOPPLEPR BIT(8), /* LINK EDITOR PARMS FOR MODULE */ 76550001 * 3 IOPPAPF BIT(1), /* APF AC=1 @VS08700*/ 76600002 * 3 IOPPRENT BIT(1), /* REENTRANT */ 76650001 * 3 IOPPREUS BIT(1), /* REUSABLE */ 76700001 * 3 IOPPSCTR BIT(1), /* SCATTER LOAD */ 76750001 * 3 IOPPOVLY BIT(1), /* OVERLAY STRUCTURE */ 76760001 * 3 IOPPREFR BIT(1), /* REFRESHABLE */ 76770001 * 3 IOPPDC BIT(1), /* DOWNWARD COMPATIBLE */ 76780001 * 3 IOPPNE BIT(1), /* NOT EDITABLE */ 76790001 * 2 IOPPNUM CHAR(5), /* PTF NUMBER FOR THIS MODULE */ 76792001 * 3 IOPPID CHAR(2), /* PTF ID BYTES */ 76794001 * 3 IOPPDIG CHAR(3), /* PACKED PTF NUMBER */ 76796001 * 2 IOPDISTN CHAR(7), /* DISTRIBUTION LIB */ 76800001 * 2 IOPINDLB CHAR(8), /* INDIRECT LIBRARY NAME */ 77100001 * 2 IOPALISL(6) CHAR(8); /* ALIASES (LIMIT IS 5 MAX) */ 77400001 ./ ADD SSI=40810761,NAME=HMASMMGP,SOURCE=1 * /****************************************************************/ 03000001 * /* */ 06000001 * /* HMASMMGP - MESSAGE PARAMETER LIST */ 09000001 * /* */ 12000001 * /****************************************************************/ 15000001 * /* */ 18000001 * /* THIS MACRO IS USED TO INTERFACE WITH THE SMP MESSAGE */ 21000001 * /* ROUTINE. THE COMPILE TIME VARIABLE: MGPNUMVR MUST BE SET */ 24000001 * /* TO INDICATE THE NUMBER OF MEMBERS OF THE VARIABLE LIST ARRAY */ 27000001 * /* TO BE GENERATED. THIS LIST IS USED TO CONTAIN POINTERS TO */ 30000001 * /* THE VARIABLE PORTION OF MESSAGES. THE VARIABLE IS CHARACTER */ 33000001 * /* DATA TYPE, THUS, IF THIS ROUTINE ONLY PUTS OUT A MESSAGE */ 36000001 * /* WITH 2 VARIABLE PARTS, THE VARIABLE MGPNUMVR IS SET EQUAL */ 39000001 * /* TO '2' PRIOR TO THE INCLUDE FOR THIS MACRO. */ 42000001 * /* THIS MACRO IS USED FOR ALL MESSAGES, WHETHER THEY ARE */ 45000001 * /* ISSUED TO THE PRINTER (SYSOUT) OR THE HISTORY LOG DATA SET */ 48000001 * /* (HLDS). */ 51000001 * /* THE MESSAGE NUMBER MUST BE INDICATED IN MGPMGNO1, THE */ 54000001 * /* PRIMARY MESSAGE NUMBER FIELD. IF THE MESSAGE HAS SECONDARY */ 57000001 * /* OR TERTIARY MESSAGE NUMBERS, THEN THEY ALSO MUST BE INDICATED*/ 60000001 * /* IN MGPMGNO2 AND MGPMGNO3. OTHERWISE, THESE FIELDS MUST BE */ 63000001 * /* ZERO. */ 66000001 * DECLARE 69000001 * 1 HMASMMGP BDY(WORD), /* MESSAGE PARAMETER LIST */ 72000001 * 2 MGPMGNO1 FIXED(8), /* PRIMARY MESSAGE NUMBER */ 75000001 * 2 MGPMGNO2 FIXED(8), /* SECONDARY MESSAGE NUMBER */ 78000001 * 2 MGPMGNO3 FIXED(8), /* TERTIARY MESSAGE NUMBER */ 81000001 * 2 MGPFLAGS BIT(8), /* FLAGS */ 84000001 * 3 MGPPRINT BIT(1), /* INDICATES PRINTER (SYSOUT) */ 87000001 * 3 MGPHLDS BIT(1), /* INDICATES HISTORY LOG DS */ 90000001 * 3 * BIT(6), /* UNUSED */ 93000001 * 2 MGPVARPT (MGPNUMVR) PTR(31); /* POINTERS TO VAR MESSAGE */ 96000001 ./ ADD SSI=40810763,NAME=HMASMPRL,SOURCE=1 * /****************************************************************/ 03000001 * /* HMASMPRL */ 06000001 * /****************************************************************/ 09000001 * /* MAPPING MACRO FOR THE BUFFER FOR THE PRINT ROUTINE AND THE */ 12000001 * /* LOG WRITE ROUTINE OF THE HMASMIO ROUTINE. TO PRINT A LINE, */ 15000001 * /* MERELY PUT THE LINE IN PRLDATA AND INDICATE THE LENGTH IN */ 18000001 * /* PRLRLEN. TO INDICATE A SUBHEADING, PUT THE SUBHEADING IN */ 21000001 * /* PRLDATA AND TURN THE SUBHEAD FLAG ON (PRLHEAD). WHEN SUB */ 24000001 * /* HEADING IS DONE, TURN ON PRLHEADO AND INVOKE PRINT. */ 27000001 * /* TO WRITE TO THE HISTORY LOG, PLACE THE RECORD IN PRLDATA, */ 30000001 * /* AND INDICATE THE LENGTH (PLUS 10) IN PRLRLEN. THE HISTORY */ 33000001 * /* LOG ROUTINE WILL FILL IN THE REMAINING FIELDS. */ 36000001 * /****************************************************************/ 39000001 * DECLARE 42000001 * 1 HMASMPRL BASED(IOPBUFAD), /* PRINTER AND LOG BUFFER MAP */ 45000001 * 2 PRLRLEN FIXED(15), /* RECORD LENGTH */ 48000001 * 2 PRLSPAN CHAR(2), /* SPAN INFORMATION (0 FOR LOG) */ 51000001 * 3 PRLFLGS BIT(8), /* FLAGS FOR PRINT USE */ 54000001 * 4 PRLHEAD BIT(1), /* INDICATES SAVE THIS SUB HEAD */ 57000001 * 4 PRLHEADO BIT(1), /* INDICATES SUB HEADING OFF */ 60000001 * 4 PRLBLANK BIT(1), /* INDICATES BLANK LINE PRINT */ 63000001 * 4 * BIT(5), /* UNUSED */ 66000001 * 2 PRLDATE CHAR(3), /* DATE IN YYDDDF */ 69000001 * 3 PRLHDADR PTR(24) BDY(BYTE), /* ADDR OF HEADING RECORD */ 72000001 * 2 PRLTIME CHAR(3), /* TIME IN HHMMSS */ 75000001 * 3 * CHAR(2), /* FILLER */ 78000001 * 3 PRLCONC CHAR(1), /* PRINTER CONTROL CHARACTER */ 81000001 * 2 PRLDATA CHAR(*); /* DATA TO BE PRINTED */ 84000001 ./ ADD SSI=40810764,NAME=HMASMSCP,SOURCE=1 /* HMASMSCP CONTAINS THE INPUT PARAMETER LIST TO THE SCAN ROUTINE. */03000001 /* SCPPMLN AND SCPRET ARE THE OUTPUT PARAMETERS CONTAINING */06000001 /* THE PARM LENGTH AND RETURN CODE. */09000001 DECLARE 12000001 %IF DSECT='NO' 15000001 %THEN %GOTO SCPNODST; 18000001 1 HMASMSCP BASED (SCPPTR), 21000001 %GOTO CONTIN; 24000001 %SCPNODST:; 27000001 1 HMASMSCP, 30000001 %CONTIN:; 33000001 3 SCPCHAR PTR(31), /* PTR TO I/L CHARACTER */36000001 3 SCPSRCH PTR(31), /* PTR TO SEARCH ELEMENT */39000001 3 SCPWKAR PTR(31), /* PTR TO WORK AREA */42000001 3 SCPIORTN PTR(31), /* ADDR OF USER I/O ROUTINE */45000001 3 SCPINLN FIXED(15), /* INPUT RECORD LENGTH */48000001 3 SCPPMLN FIXED(15), /* PASSBACK LENGTH */51000001 3 SCPEOR BIT(8), /* END OF RECORD FLAG BYTE */54000001 5 SCPCONT BIT(1), /* CONTINUATION CHECK */57000001 5 SCPNOCT BIT(1), /* NO CONTINUATION CHECK */60000001 5 SCPCOMNT BIT(1), /* CHECK FOR COMMENT DELIMS */63000001 5 * BIT(5), /* RESERVED */66000001 3 SCPRET FIXED(8); /* RETURN CODE FROM SCAN */69000001 ./ ADD SSI=40810766,NAME=HMASMSET,SOURCE=1 /* MAPPING MACRO FOR THE HMASMP SELECT EXCLUDE TABLE */ 03000001 DECLARE 06000001 1 HMASMSET(*)BASED(SETPTR)BDY(WORD), 09000001 2 SEFLAGS BIT(8), /* FLAG BYTE */ 12000001 3 SESELECT BIT(1), /* SELECT OPTION */ 15000001 3 SEEXCLUD BIT(1), /* EXCLUDE OPTION */ 18000001 3 SEFORCE BIT(1), /* FORCE OPTION */ 21000001 3 * BIT(3), /* UNUSED */ 24000001 3 SEFOUND BIT(1), /* PTF FOUND */ 27000001 3 SELAST BIT(1), /* LAST PTF INDICATOR */ 30000001 2 SEPTFNO CHAR(7); /* PTF NUMBER */ 33000001 ./ ADD SSI=01011928,SOURCE=1,NAME=HOOKTAB GENERATE; /* 00400021 MACRO 00800021 &NAME HOOKTAB &EL1=,&EL2=,&EL3=,&EL4=,&EL5=,&EL6=,&EL7=,&EL8=, X01200021 &EL9=,&EL10=,&EL11=,&EL12=,&EL13=,&EL14=,&EL15=,&EL16=, X01600021 &EL17=,&EL18=,&EL19=,&EL20=,&EL21=,&EL22=,&EL23=,&EL24=,X02000021 &EL25=,&TERMAD=0, X02400021 &FC1=,&FC2=,&FC3=,&FC4=,&FC5=,&FC6=,&FC7=,&FC8=, X02800021 &FC9=,&FC10=,&FC11=,&FC12=,&FC13=,&FC14=,&FC15=,&FC16=, X03200021 &FC17=,&FC18=,&FC19=,&FC20=,&FC21=,&FC22=,&FC23=,&FC24=,X03600021 &FC25= 04000021 GBLA &N,&M,&R,&DEC(100) 04400021 GBLB &B1(25),&B2(25),&B3(25),&B4(25),&B5(25),&B6(25),&B7(25) 04800021 GBLC &H(25),&HX(25),&A(25),&DEN(100),&E(25) 05200021 LCLA &L,&BOT 05600021 LCLB &B4T 06000021 .*A000000-999999 S21014 06050021 .* INITIALIZE GLOBALS INIT 06400021 &M SETA 0 INIT 06800021 .CK AIF (&N EQ 0).CKR INIT 07200021 &HX(&N) SETC '' INIT 07600021 &B1(&N) SETB 0 INIT 08000021 &B2(&N) SETB 0 INIT 08400021 &B3(&N) SETB 0 INIT 08800021 &B4(&N) SETB 0 INIT 09200021 &B5(&N) SETB 0 INIT 09600021 &B6(&N) SETB 0 INIT 10000021 &B7(&N) SETB 0 INIT 10400021 &N SETA &N-1 INIT 10800021 AGO .CK INIT 11200021 .CKR AIF (&R EQ 0).START INIT 11600021 &DEC(&R) SETA 0 INIT 12000021 &R SETA &R-1 INIT 12400021 AGO .CKR INIT 12800021 .* INIT 13200021 .START AIF ('&EL1' EQ '').E2 13600021 HKENT &EL1(1),&EL1(2),&EL1(3),&FC1,EL1 14000021 .E2 AIF ('&EL2' EQ '').E3 14400021 HKENT &EL2(1),&EL2(2),&EL2(3),&FC2,EL2 14800021 .E3 AIF ('&EL3' EQ '').E4 15200021 HKENT &EL3(1),&EL3(2),&EL3(3),&FC3,EL3 15600021 .E4 AIF ('&EL4' EQ '').E5 16000021 HKENT &EL4(1),&EL4(2),&EL4(3),&FC4,EL4 16400021 .E5 AIF ('&EL5' EQ '').E6 16800021 HKENT &EL5(1),&EL5(2),&EL5(3),&FC5,EL5 17200021 .E6 AIF ('&EL6' EQ '').E7 17600021 HKENT &EL6(1),&EL6(2),&EL6(3),&FC6,EL6 18000021 .E7 AIF ('&EL7' EQ '').E8 18400021 HKENT &EL7(1),&EL7(2),&EL7(3),&FC7,EL7 18800021 .E8 AIF ('&EL8' EQ '').E9 19200021 HKENT &EL8(1),&EL8(2),&EL8(3),&FC8,EL8 19600021 .E9 AIF ('&EL9' EQ '').E10 20000021 HKENT &EL9(1),&EL9(2),&EL9(3),&FC9,EL9 20400021 .E10 AIF ('&EL10' EQ '').E11 20800021 HKENT &EL10(1),&EL10(2),&EL10(3),&FC10,EL10 21200021 .E11 AIF ('&EL11' EQ '').E12 21600021 HKENT &EL11(1),&EL11(2),&EL11(3),&FC11,EL11 22000021 .E12 AIF ('&EL12' EQ '').E13 22400021 HKENT &EL12(1),&EL12(2),&EL12(3),&FC12,EL12 22800021 .E13 AIF ('&EL13' EQ '').E14 23200021 HKENT &EL13(1),&EL13(2),&EL13(3),&FC13,EL13 23600021 .E14 AIF ('&EL14' EQ '').E15 24000021 HKENT &EL14(1),&EL14(2),&EL14(3),&FC14,EL14 24400021 .E15 AIF ('&EL15' EQ '').E16 24800021 HKENT &EL15(1),&EL15(2),&EL15(3),&FC15,EL15 25200021 .E16 AIF ('&EL16' EQ '').E17 25600021 HKENT &EL16(1),&EL16(2),&EL16(3),&FC16,EL16 26000021 .E17 AIF ('&EL17' EQ '').E18 26400021 HKENT &EL17(1),&EL17(2),&EL17(3),&FC17,EL17 26800021 .E18 AIF ('&EL18' EQ '').E19 27200021 HKENT &EL18(1),&EL18(2),&EL18(3),&FC18,EL18 27600021 .E19 AIF ('&EL19' EQ '').E20 28000021 HKENT &EL19(1),&EL19(2),&EL19(3),&FC19,EL19 28400021 .E20 AIF ('&EL20' EQ '').E21 28800021 HKENT &EL20(1),&EL20(2),&EL20(3),&FC20,EL20 29200021 .E21 AIF ('&EL21' EQ '').E22 29600021 HKENT &EL21(1),&EL21(2),&EL21(3),&FC21,EL21 30000021 .E22 AIF ('&EL22' EQ '').E23 30400021 HKENT &EL22(1),&EL22(2),&EL22(3),&FC22,EL22 30800021 .E23 AIF ('&EL23' EQ '').E24 31200021 HKENT &EL23(1),&EL23(2),&EL23(3),&FC23,EL23 31600021 .E24 AIF ('&EL24' EQ '').E25 32000021 HKENT &EL24(1),&EL24(2),&EL24(3),&FC24,EL24 32400021 .E25 AIF ('&EL25' EQ '').E26 32800021 HKENT &EL25(1),&EL25(2),&EL25(3),&FC25,EL25 33200021 .E26 AIF (N'&SYSLIST GT 2*&N+1).ERR1 33600021 AIF (N'&SYSLIST GT 2*&N AND '&TERMAD' EQ '0').ERR1 34000021 .* TEST STATI OF ELEMENTS 34400021 &L SETA &N+1 34800021 .HT1 ANOP 35200021 &L SETA &L-1 35600021 AIF (&L EQ 0).GENTAB 36000021 &BOT SETA &L 36400021 .HT2 AIF (&B6(&L)).HT1 36800021 &L SETA &L-1 37200021 AIF (&B3(&L) EQ &B3(&BOT)).HT2 37600021 &B3(&L) SETB (&B3(&BOT)) 38000021 AIF (NOT &B7(&L)).HT2 38400021 MNOTE 4,' ISM30105 *** &E(&L) *** STATUS CONFLICTS WITH CHAIN' 38800021 AGO .HT2 39200021 .GENTAB SPACE 39600021 CNOP 0,4 40000021 &NAME EQU * 40400021 DC AL2(&N) NUMBER OF ELEMENTS SPECIFIED 40800021 DC AL2(&N+&M) NUMBER OF PHYSICAL ENTRIES 41200021 DC A(&TERMAD) TERMAD ADDRESS 41600021 SPACE 42000021 AIF (&N EQ 0).END 42400021 &B4(&N) SETB 0 42800021 .GMORE ANOP 43200021 &L SETA &L+1 43600021 &B4T SETB (&B4(&L)) 44000021 &B4(&L) SETB (&B4(&L) OR '&HX(&L)' NE '') 44400021 .IRANGE ANOP 44800021 DC BL1'&B1(&L)&B2(&L)&B3(&L)&B4(&L)&B5(&L)&B6(&L).00' 45200021 DC AL1(0) AID 45600021 DC XL2'&H(&L)' 46000021 DC A(&A(&L)) ROUTINE ADDRESS 46400021 AIF ('&HX(&L)' EQ '').NRANGE 46800021 &H(&L) SETC '&HX(&L)' 47200021 &HX(&L) SETC '' 47600021 &B4(&L) SETB (&B4T) 48000021 &B5(&L) SETB 1 48400021 &B6(&L) SETB 0 48800021 AGO .IRANGE 49200021 .NRANGE SPACE 49600021 AIF (&L NE &N).GMORE 50000021 .* CONTROL INFORMATION 50400021 &L SETA 0 50800021 .DMORE ANOP 51200021 &L SETA &L+1 51600021 DC AL1(&DEC(&L)) 52000021 DC AL1(&DEN(&L)) 52400021 AIF (&DEC(&L) NE 0).TESTL 52800021 SPACE 53200021 .TESTL AIF (&L LT &R).DMORE 53600021 .END MEXIT 54000021 .ERR1 MNOTE 8,' ISM30101 *** TOO MANY OPERANDS ' 54400021 MEND 54800021 MACRO 55200021 HKENT &E1,&E2,&E3,&E4,&ELN 55600021 GBLA &N,&M,&R,&DEC(100) 56000021 GBLB &B1(25),&B2(25),&B3(25),&B4(25),&B5(25),&B6(25),&B7(25) 56400021 GBLC &H(25),&HX(25),&A(25),&DEN(100),&E(25) 56800021 LCLA &X,&Y 57200021 LCLC &R1,&R2 57600021 &N SETA &N+1 58000021 AIF (K'&E1 NE 4).NHK 58400021 AIF ('&E1' EQ 'NULL').NULL 58800021 &H(&N) SETC '&E1' 59200021 AGO .ADDR 59600021 .NULL ANOP 60000021 &H(&N) SETC '0000' 60400021 &B5(&N) SETB 1 60800021 AGO .ADDR 61200021 .NHK AIF (K'&E1 NE 1).NCL 61600021 &H(&N) SETC '&E1'.'000' 62000021 &B2(&N) SETB 1 62400021 AGO .ADDR 62800021 .NCL AIF (K'&E1 NE 11).NRG 63200021 &H(&N) SETC '&E1'(2,4) 63600021 &HX(&N) SETC '&E1'(7,4) 64000021 &Y SETA 1 64400021 .RCK AIF (&Y GT 5).ROK 64800021 &Y SETA &Y+1 65200021 &R1 SETC '&E1'(&Y,1) 65600021 &R2 SETC '&E1'(&Y+5,1) 66000021 AIF ('&R1' EQ '&R2').RCK 66400021 AIF ('&R1' GE '0' AND '&R2' GE '0' AND '&R1' LE '&R2').ROK 66800021 AIF ('&R1' LT '0' AND '&R2' LT '0' AND '&R1' LE '&R2').ROK 67200021 AIF ('&R1' GE '0' AND '&R2' LT '0').ROK 67600021 MNOTE 4,' ISM30108 *** &ELN *** IMPROPER RANGE SPECIFICATION ' 68000021 .ROK ANOP 68400021 &B1(&N) SETB 1 68800021 &M SETA &M+1 69200021 AGO .ADDR 69600021 .NRG AIF ('&E1' NE 'ALL').ERR3 70000021 &H(&N) SETC '0000' 70400021 &B1(&N) SETB 1 70800021 &B2(&N) SETB 1 71200021 AGO .ADDR 71600021 .ERR3 MNOTE 8,' ISM30102 *** &ELN *** INVALID HOOK SPECIFICATION ' 72000021 .ADDR AIF ('&E2' NE '').ADDOK 72400021 MNOTE 8,' ISM30103 *** &ELN *** NO ADDRESS SPECIFIED ' 72800021 .ADDOK ANOP 73200021 &A(&N) SETC '&E2' 73600021 AIF ('&E3' EQ '' OR '&E3' EQ 'E' OR '&E3' EQ 'D').VALID 74000021 AIF ('&E3' EQ 'L' OR '&E3' EQ 'LE' OR '&E3' EQ 'LD').VALID 74400021 MNOTE 8,' ISM30104 *** &ELN *** INVALID STATUS ' 74800021 &B4(&N) SETB 1 75200021 AGO .OPTS 75600021 .VALID ANOP 76000021 .* CHAIN BIT 76400021 &B4(&N) SETB ('&E3' EQ '' OR '&E3' EQ 'E' OR '&E3' EQ 'D') 76800021 .* DISABLE-ENABLE BIT 77200021 &B3(&N) SETB ('&E3' EQ 'D' OR '&E3' EQ 'LD') 77600021 &B7(&N) SETB ('&E3' EQ 'E' OR '&E3' EQ 'D') 78000021 &E(&N) SETC '&ELN' 78400021 .OPTS ANOP 78800021 AIF (&N EQ 1).FIRSTE 79200021 AIF (&B4(&N-1)).OPTSC 79600021 .FIRSTE ANOP 80000021 &B6(&N) SETB 1 80400021 .OPTSC ANOP 80800021 &R SETA &R+1 81200021 AIF (&R GT 100).ERR7 81600021 &X SETA &X+1 82000021 AIF (&X LE N'&E4).MORE 82400021 &DEN(&R) SETC '0' 82800021 MEXIT 83200021 .MORE AIF (&DEC(&R) EQ 4).ERR6 83600021 &DEC(&R) SETA &DEC(&R)+1 84000021 AIF ('&E4(&X)'(1,2) NE 'E+E-D+D-'(2*&DEC(&R)-1,2)).MORE 84400021 &DEN(&R) SETC '&E4(&X)'(3,K'&E4(&X)-2) 84800021 AGO .OPTSC 85200021 .ERR6 MNOTE 8,' ISM30106 *** &ELN *** INVALID OPERAND IN FC ' 85600021 AGO .OPTSC 86000021 .ERR7 MNOTE 8,' ISM30107 *** &ELN *** FC MAXIMUM OVERRUN ' 86400021 MEND 86800021 @ENDGEN */ 87200021 ./ ADD SSI=41500116,NAME=ICFWORK,SOURCE=0 MACRO 00400021 ICFWORK &GENCODE=NO PWF 00800021 AIF ('&GENCODE' NE 'YES').DSECT PWF 01200021 ICFWORKA CSECT PWF 01600021 AGO .COM PWF 02000021 .DSECT ANOP PWF 02400021 ICFWORKA DSECT PWF 02800021 .COM ANOP PWF 03200021 ICFADR1 DC F'0' POINTER TO FOOTPRINT TABLE 03600021 ICFADR2 DC F'0' *VS2-2 - REAL ADDR OF PCCA VECTOR TABLE 04000021 ICFADR3 DC F'0' *VS2-2 - REAL ADDRESS OF CSD 04400021 ICFADR4 DC F'0' *POINTER TO ICFBIE00 - (ICFTIE00 FOR MVT ONLY) 04800021 SPACE 3 05200021 ICFSEK00 DC X'07',AL3(ICFCHR00),X'60',XL3'6' *SEEK CCW TRK 00 PWF 05600021 ICFSRC00 DC X'31',AL3(ICFCHR00+2),X'60',XL3'5' *SRC FOR TRK 00 PWF 06000021 ICFTIC00 DC X'08',AL3(ICFSRC00),X'60',XL3'1' *TIC CCW TRK 00 PWF 06400021 ICFWRD00 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 00 PWF 06800021 SPACE 07200021 ICFSEK01 DC X'07',AL3(ICFCHR01),X'60',XL3'6' *SEEK CCW TRK 01 PWF 07600021 ICFSRC01 DC X'31',AL3(ICFCHR01+2),X'60',XL3'5' *SRC FOR TRK 01 PWF 08000021 ICFTIC01 DC X'08',AL3(ICFSRC01),X'60',XL3'1' *TIC CCW TRK 01 PWF 08400021 ICFWRD01 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 01 PWF 08800021 SPACE 09200021 ICFSEK02 DC X'07',AL3(ICFCHR02),X'60',XL3'6' *SEEK CCW TRK 02 PWF 09600021 ICFSRC02 DC X'31',AL3(ICFCHR02+2),X'60',XL3'5' *SRC FOR TRK 02 PWF 10000021 ICFTIC02 DC X'08',AL3(ICFSRC02),X'60',XL3'1' *TIC CCW TRK 02 PWF 10400021 ICFWRD02 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 02 PWF 10800021 SPACE 11200021 ICFSEK03 DC X'07',AL3(ICFCHR03),X'60',XL3'6' *SEEK CCW TRK 03 PWF 11600021 ICFSRC03 DC X'31',AL3(ICFCHR03+2),X'60',XL3'5' *SRC FOR TRK 03 PWF 12000021 ICFTIC03 DC X'08',AL3(ICFSRC03),X'60',XL3'1' *TIC CCW TRK 03 PWF 12400021 ICFWRD03 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 03 PWF 12800021 SPACE 13200021 ICFSEK04 DC X'07',AL3(ICFCHR04),X'60',XL3'6' *SEEK CCW TRK 04 PWF 13600021 ICFSRC04 DC X'31',AL3(ICFCHR04+2),X'60',XL3'5' *SRC FOR TRK 04 PWF 14000021 ICFTIC04 DC X'08',AL3(ICFSRC04),X'60',XL3'1' *TIC CCW TRK 04 PWF 14400021 ICFWRD04 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 04 PWF 14800021 SPACE 15200021 ICFSEK05 DC X'07',AL3(ICFCHR05),X'60',XL3'6' *SEEK CCW TRK 05 PWF 15600021 ICFSRC05 DC X'31',AL3(ICFCHR05+2),X'60',XL3'5' *SRC FOR TRK 05 PWF 16000021 ICFTIC05 DC X'08',AL3(ICFSRC05),X'60',XL3'1' *TIC CCW TRK 05 PWF 16400021 ICFWRD05 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 05 PWF 16800021 SPACE 17200021 ICFSEK06 DC X'07',AL3(ICFCHR06),X'60',XL3'6' *SEEK CCW TRK 06 PWF 17600021 ICFSRC06 DC X'31',AL3(ICFCHR06+2),X'60',XL3'5' *SRC FOR TRK 06 PWF 18000021 ICFTIC06 DC X'08',AL3(ICFSRC06),X'60',XL3'1' *TIC CCW TRK 06 PWF 18400021 ICFWRD06 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 06 PWF 18800021 SPACE 19200021 ICFSEK07 DC X'07',AL3(ICFCHR07),X'60',XL3'6' *SEEK CCW TRK 07 PWF 19600021 ICFSRC07 DC X'31',AL3(ICFCHR07+2),X'60',XL3'5' *SRC FOR TRK 07 PWF 20000021 ICFTIC07 DC X'08',AL3(ICFSRC07),X'60',XL3'1' *TIC CCW TRK 07 PWF 20400021 ICFWRD07 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 07 PWF 20800021 SPACE 21200021 ICFSEK08 DC X'07',AL3(ICFCHR08),X'60',XL3'6' *SEEK CCW TRK 08 PWF 21600021 ICFSRC08 DC X'31',AL3(ICFCHR08+2),X'60',XL3'5' *SRC FOR TRK 08 PWF 22000021 ICFTIC08 DC X'08',AL3(ICFSRC08),X'60',XL3'1' *TIC CCW TRK 08 PWF 22400021 ICFWRD08 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 08 PWF 22800021 SPACE 23200021 ICFSEK09 DC X'07',AL3(ICFCHR09),X'60',XL3'6' *SEEK CCW TRK 09 PWF 23600021 ICFSRC09 DC X'31',AL3(ICFCHR09+2),X'60',XL3'5' *SRC FOR TRK 09 PWF 24000021 ICFTIC09 DC X'08',AL3(ICFSRC09),X'60',XL3'1' *TIC CCW TRK 09 PWF 24400021 ICFWRD09 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 09 PWF 24800021 SPACE 25200021 ICFSEK10 DC X'07',AL3(ICFCHR10),X'60',XL3'6' *SEEK CCW TRK 10 PWF 25600021 ICFSRC10 DC X'31',AL3(ICFCHR10+2),X'60',XL3'5' *SRC FOR TRK 10 PWF 26000021 ICFTIC10 DC X'08',AL3(ICFSRC10),X'60',XL3'1' *TIC CCW TRK 10 PWF 26400021 ICFWRD10 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 10 PWF 26800021 SPACE 27200021 ICFSEK11 DC X'07',AL3(ICFCHR11),X'60',XL3'6' *SEEK CCW TRK 11 PWF 27600021 ICFSRC11 DC X'31',AL3(ICFCHR11+2),X'60',XL3'5' *SRC FOR TRK 11 PWF 28000021 ICFTIC11 DC X'08',AL3(ICFSRC11),X'60',XL3'1' *TIC CCW TRK 11 PWF 28400021 ICFWRD11 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 11 PWF 28800021 SPACE 29200021 ICFSEK12 DC X'07',AL3(ICFCHR12),X'60',XL3'6' *SEEK CCW TRK 12 PWF 29600021 ICFSRC12 DC X'31',AL3(ICFCHR12+2),X'60',XL3'5' *SRC FOR TRK 12 PWF 30000021 ICFTIC12 DC X'08',AL3(ICFSRC12),X'60',XL3'1' *TIC CCW TRK 12 PWF 30400021 ICFWRD12 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 12 PWF 30800021 SPACE 31200021 ICFSEK13 DC X'07',AL3(ICFCHR13),X'60',XL3'6' *SEEK CCW TRK 13 PWF 31600021 ICFSRC13 DC X'31',AL3(ICFCHR13+2),X'60',XL3'5' *SRC FOR TRK 13 PWF 32000021 ICFTIC13 DC X'08',AL3(ICFSRC13),X'60',XL3'1' *TIC CCW TRK 13 PWF 32400021 ICFWRD13 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 13 PWF 32800021 SPACE 33200021 ICFSEK14 DC X'07',AL3(ICFCHR14),X'60',XL3'6' *SEEK CCW TRK 14 PWF 33600021 ICFSRC14 DC X'31',AL3(ICFCHR14+2),X'60',XL3'5' *SRC FOR TRK 14 PWF 34000021 ICFTIC14 DC X'08',AL3(ICFSRC14),X'60',XL3'1' *TIC CCW TRK 14 PWF 34400021 ICFWRD14 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 14 PWF 34800021 SPACE 35200021 ICFSEK15 DC X'07',AL3(ICFCHR15),X'60',XL3'6' *SEEK CCW TRK 15 PWF 35600021 ICFSRC15 DC X'31',AL3(ICFCHR15+2),X'60',XL3'5' *SRC FOR TRK 15 PWF 36000021 ICFTIC15 DC X'08',AL3(ICFSRC15),X'60',XL3'1' *TIC CCW TRK 15 PWF 36400021 ICFWRD15 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 15 PWF 36800021 SPACE 37200021 ICFSEK16 DC X'07',AL3(ICFCHR16),X'60',XL3'6' *SEEK CCW TRK 16 PWF 37600021 ICFSRC16 DC X'31',AL3(ICFCHR16+2),X'60',XL3'5' *SRC FOR TRK 16 PWF 38000021 ICFTIC16 DC X'08',AL3(ICFSRC16),X'60',XL3'1' *TIC CCW TRK 16 PWF 38400021 ICFWRD16 DC X'05',AL3(0),X'40',XL3'3000' *WRITE DATA TRK 16 PWF 38800021 SPACE 39200021 ICFSEK17 DC X'07',AL3(ICFCHR17),X'60',XL3'6' *SEEK CCW TRK 17 PWF 39600021 ICFSRC17 DC X'31',AL3(ICFCHR17+2),X'60',XL3'5' *SRC FOR TRK 17 PWF 40000021 ICFTIC17 DC X'08',AL3(ICFSRC17),X'60',XL3'1' *TIC CCW TRK 17 PWF 40400021 ICFWRD17 DC X'05',AL3(0),X'00',XL3'3000' *WRITE DATA TRK 17 PWF 40800021 SPACE 41200021 ICFSEK18 DC X'07',AL3(ICFCHR18),X'60',XL3'6' *SEEK CCW TRK 18 PWF 41600021 ICFSRC18 DC X'31',AL3(ICFCHR18+2),X'60',XL3'5' *SRC FOR TRK 18 PWF 42000021 ICFTIC18 DC X'08',AL3(ICFSRC18),X'60',XL3'1' *TIC CCW TRK 18 PWF 42400021 ICFWRD18 DC X'05',AL3(0),X'00',XL3'3000' *WRITE DATA TRK 18 PWF 42800021 SPACE 43200021 ICFSEK19 DC X'07',AL3(ICFCHR19),X'60',XL3'6' *SEEK CCW TRK 19 PWF 43600021 ICFSRC19 DC X'31',AL3(ICFCHR19+2),X'60',XL3'5' *SRC FOR TRK 19 PWF 44000021 ICFTIC19 DC X'08',AL3(ICFSRC19),X'60',XL3'1' *TIC CCW TRK 19 PWF 44400021 ICFWRD19 DC X'05',AL3(0),X'00',XL3'3000' *WRITE DATA TRK 19 PWF 44800021 SPACE 3 45200021 ICFWADEV DC XL4'450' *DEVICE ADDRESS OF PRIMARY DATA SET PWF 45600021 ICFWAUCB DC XL4'0' *UCB ADDRESS OF PRIMARY DATA SET PWF 46000021 ICFWACHR DC X'00000000000001' *START OF PRIMARY EXTENT PWF 46400021 ICFFLAGA DC X'00' *FLAG A FIELD PWF 46800021 SPACE 47200021 ICFINOP EQU X'80' *PWF FUNCTION INOPERATIVE PWF 47600021 ICFCMTDM EQU X'40' *COMMIT TO DUMP PWF 47800021 ICFUSRC4 EQU X'20' *USER SET RETURN CODE OF 4 48000021 SPACE 3 48400021 ICFWBDEV DC XL4'457' *DEVICE ADDRESS OF ALTRNT DATA SET PWF 48800021 ICFWBUCB DC XL4'0' *UCB ADDRESS OF ALTRNT DATA SET PWF 49200021 ICFWBCHR DC X'00000000000001' *START OF ALTRNT EXTENT PWF 49600021 ICFFLAGB DC X'00' *FLAG B FIELD PWF 50000021 SPACE 50400021 ICFMVT EQU X'10' *SYSTEM TYPE - MVT 50800021 ICFSVM EQU X'12' *SYSTEM TYPE - VS2 R1 51200021 ICFMVM EQU X'13' *SYSTEM TYPE - VS2 R2 51600021 ICFVS1 EQU X'22' *SYSTEM TYPE - VS1 R3 52000021 SPACE 3 52400021 ICFTRSIZ DC F'12288' *NUMBER OF BYTES PER TRACK PWF 52800021 ICFTPC DC F'19' *NUMBER OF TRACKS PER CYLINDER PWF 53200021 SPACE 3 53600021 ICFCHR00 DC X'0000000000000100' *SEEK/SRCH ADDR.FOR TRK 00 PWF 54000021 ICFCHR01 DC X'0000000000010100' *SEEK/SRCH ADDR.FOR TRK 01 PWF 54400021 ICFCHR02 DC X'0000000000020100' *SEEK/SRCH ADDR.FOR TRK 02 PWF 54800021 ICFCHR03 DC X'0000000000030100' *SEEK/SRCH ADDR.FOR TRK 03 PWF 55200021 ICFCHR04 DC X'0000000000040100' *SEEK/SRCH ADDR.FOR TRK 04 PWF 55600021 ICFCHR05 DC X'0000000000050100' *SEEK/SRCH ADDR.FOR TRK 05 PWF 56000021 ICFCHR06 DC X'0000000000060100' *SEEK/SRCH ADDR.FOR TRK 06 PWF 56400021 ICFCHR07 DC X'0000000000070100' *SEEK/SRCH ADDR.FOR TRK 07 PWF 56800021 ICFCHR08 DC X'0000000000080100' *SEEK/SRCH ADDR.FOR TRK 08 PWF 57200021 ICFCHR09 DC X'0000000000090100' *SEEK/SRCH ADDR.FOR TRK 09 PWF 57600021 ICFCHR10 DC X'00000000000A0100' *SEEK/SRCH ADDR.FOR TRK 10 PWF 58000021 ICFCHR11 DC X'00000000000B0100' *SEEK/SRCH ADDR.FOR TRK 11 PWF 58400021 ICFCHR12 DC X'00000000000C0100' *SEEK/SRCH ADDR.FOR TRK 12 PWF 58800021 ICFCHR13 DC X'00000000000D0100' *SEEK/SRCH ADDR.FOR TRK 13 PWF 59200021 ICFCHR14 DC X'00000000000E0100' *SEEK/SRCH ADDR.FOR TRK 14 PWF 59600021 ICFCHR15 DC X'00000000000F0100' *SEEK/SRCH ADDR.FOR TRK 15 PWF 60000021 ICFCHR16 DC X'0000000000100100' *SEEK/SRCH ADDR.FOR TRK 16 PWF 60400021 ICFCHR17 DC X'0000000000110100' *SEEK/SRCH ADDR.FOR TRK 17 PWF 60800021 ICFCHR18 DC X'0000000000120100' *SEEK/SRCH ADDR.FOR TRK 18 PWF 61200021 ICFCHR19 DC X'0000000000130100' *SEEK/SRCH ADDR.FOR TRK 19 PWF 61600021 SPACE 3 62000021 ICFSTSIZ DC F'2097152' *STORAGE SIZE PWF 62400021 ICFTME00 DC F'2000' *ORIGINAL TIME VALUE (IN MSEC) PWF 62800021 ICFTME01 DC XL8'200000000' *ORIGINAL TIME IN TOD UNITS PWF 63200021 ICFTOD00 DC XL8'0' *TIME AT ENTRY TO MCH APPENDAGE PWF 63600021 ICFTOD01 DC XL8'0' *TIME AT INNER WARNING SIGNALS PWF 64000021 ICFTOD99 DC XL8'0' *TIME TO COMMIT TO DUMP PWF 64400021 ICFLRDAT DC F'0' *DATE OF DUMP FOR LOGREC 64800021 ICFLRTIM DC F'0' *TIME OF DUMP FOR LOGREC 65200021 ICFLRCPU DC D'0' *CPU ID FOR LOGREC 65600021 ICFLRCHA DC D'0' *CHANNEL ASSIGNMENT FOR LOGREC 66000021 ICFRSVD1 DC 2D'0' *RESERVED 66400021 ICFPXREG DC F'0' *PREFIX REGISTER CONTENTS AT DUMP TIME 66800021 ICFTRMSA DC F'0' *TRACE FLAGS FOR MSI APPENDAGE 67200021 ICFTRMCA DC F'0' *TRACE FLAGS FOR MCH APPENDAGE 67600021 ICFTRDMP DC F'0' *TRACE FLAGS FOR DUMP 68000021 ICFIOMAP DC 9D'0' *WORK AREA FOR IOSGEN PWF 68400021 SPACE 3 68800021 ICFCNTRK DS 0CL512 *BUFFER FOR CONTROL RECORD PWF 69200021 ICFCTID DC CL4'CNTL' *CONTROL TRACK IDENTIFIER PWF 69600021 ICFCTCF DC 128X'12' *CYLINDER FLAGS FOR 128 CYLINDERS PWF 70000021 ICFCTFLA DC X'00' *CONTROL TRACK FLAG A PWF 70400021 SPACE 70800021 ICFCTEMP EQU X'00' *DATA SET IS EMPTY PWF 71200021 ICFCTFUL EQU X'80' *DATA SET CONTAINS VALID DUMP PWF 71600021 ICFCTINV EQU X'08' *DATA SET CONTAINS INVALID DUMP PWF 72000021 ICFCTFBT EQU X'84' *DATA SET CONTAINS VALID DUMP BUT ONE PWF 72400021 * *OR MORE TRACKS GAVE I/O ERRORS - PWF 72800021 * *ALTERNATE TRACK(S) ARE IN USE PWF 73200021 SPACE 3 73600021 ICFCTTS DC F'12288' *NO OF BYTES PER TRACK PWF 74000021 ICFCTAWA DC F'0' *ADDRESS OF PWF WORK AREA PWF 74400021 SPACE 74800021 ICFCTB11 DC F'0' *START OF STRG BLK ADDRESS PWF 75200021 ICFCTB12 DC X'00010000' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 75600021 ICFCTB13 DC F'2097152' *END OF STRG BLK ADDRESS PWF 76000021 ICFCTB14 DC X'000A0008' *TRK ADDR AT WHICH STRG BLK ENDS PWF 76400021 SPACE 76800021 ICFCTB21 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 77200021 ICFCTB22 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 77600021 ICFCTB23 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 78000021 ICFCTB24 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 78400021 SPACE 78800021 ICFCTB31 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 79200021 ICFCTB32 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 79600021 ICFCTB33 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 80000021 ICFCTB34 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 80400021 SPACE 80800021 ICFCTB41 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 81200021 ICFCTB42 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 81600021 ICFCTB43 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 82000021 ICFCTB44 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 82400021 SPACE 82800021 ICFCTB51 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 83200021 ICFCTB52 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 83600021 ICFCTB53 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 84000021 ICFCTB54 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 84400021 SPACE 84800021 ICFCTB61 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 85200021 ICFCTB62 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 85600021 ICFCTB63 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 86000021 ICFCTB64 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 86400021 SPACE 86800021 ICFCTB71 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 87200021 ICFCTB72 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 87600021 ICFCTB73 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 88000021 ICFCTB74 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 88400021 SPACE 88800021 ICFCTB81 DC X'FFFFFFFF' *START OF STRG BLK ADDRESS PWF 89200021 ICFCTB82 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK BEGINS PWF 89600021 ICFCTB83 DC X'FFFFFFFF' *END OF STRG BLK ADDRESS PWF 90000021 ICFCTB84 DC X'FFFFFFFF' *TRK ADDR AT WHICH STRG BLK ENDS PWF 90400021 SPACE 3 90800021 ICFCTST DC XL8'0' *TOD AT ENTRY TO MCH APPENDAGE PWF 91200021 ICFCTED DC XL8'0' *TOD AT END OF DUMP PWF 91600021 ICFCTTPC DC F'0' *NO. TRKS PER CYLINDER 92000021 ICFCTRDA DC F'0' *DEVICE ADDRESS FOR RESTORE 92400021 ICFCTPXR DC F'0' *PREFIX REGISTER CONTENTS AT DUMP TIME 92800021 ICFCTSTS DC F'0' *HIGHEST STORAGE ADDRESS FOR LOGREC 93200021 ICFCTDAT DC F'0' *DATE OF DUMP FOR LOGREC 93600021 ICFCTTIM DC F'0' *TIME OF DUMP FOR LOGREC 94000021 ICFCTCPU DC D'0' *CPU ID FOR LOGREC 94400021 ICFCTCHA DC D'0' *CHANNEL ASSIGNMENT FOR LOGREC 94800021 ICFCTRSV DC XL184'0' *RESERVED 95200021 ICFCTEND EQU * *END OF CONTROL TRACK BUFFER 95600021 SPACE 3 96000021 ICFRSVD2 DC 2D'0' *RESERVED PWF 96400021 ICFSAVE DC 16F'0' *REGISTER SAVE AREA FOR USER EXIT PWF 96800021 ICFSNMCP DC D'0' * SA FOR HIS MCNPSW PWF 97200021 ICFMCOPS DC D'0' * SA FOR HIS MCOPSW PWF 97600021 ICFDMPWA DC 20D'0' *WORK AREA FOR DUMP ROUTINE 98000021 ICFRSVD3 DC 32D'0' *RESERVED 98400021 ICFWAEND EQU * *END OF PWF COMMUNICATION AREA 98800021 MEND 99200021 ./ ADD SSI=40940129,NAME=IEAAAB,SOURCE=0 MACRO 00200018 IEAAAB &PA,&PC,&PD . 00400021 LCLB &TRACE 00600018 LCLB &ONETASK 00800018 .*1040 A00A 01000018 .*918900,919000,919100,919200,919300,919400,919500 AD A58233 01010021 LCLB &ATT I250 01050021 &TRACE SETB (T'&PC NE 'O') 01100021 &ONETASK SETB (T'&PA EQ 'O') 01150021 &ATT SETB (T'&PD NE 'O') I250 01900019 AIF (&ONETASK EQ 0).SKIPB 02000021 TITLE 'ROUTINE NAME - ABTERM. MODULE NAME - IEAAAB00.' 02200018 *GENERATION- DEC65,CHANGE LEVEL 000 02400018 * ROUTINE NAME - ABTERM. MODULE NAME - IEAAAB00. 02600018 AGO .SKIPC 02800018 * ROLLOUT OPTION CODE REMOVED IN RELEASE 21 21372 02850021 .SKIPB ANOP 04000018 AIF (&ATT EQ 1).SATT I250 04100019 AIF (&TRACE EQ 1).SKARD 04200018 TITLE 'ROUTINE NAME - ABTERM. MODULE NAME - IEAGAB00.' 04400018 * ROUTINE NAME - ABTERM. MODULE NAME - IEAGAB00. 04600018 AGO .SKIPC 04800018 .SKARD ANOP 05000018 TITLE 'ROUTINE NAME - ABTERM. MODULE NAME - IEAIAB00' 05200018 * ROUTINE NAME - ABTERM. MODULE NAME - IEAIAB00 05400018 AGO .SKIPC I250 05450019 .SATT ANOP I250 05500019 AIF (&TRACE EQ 1).SATTWT AC M1444 05520021 TITLE 'ROUTINE NAME-ABTERM. MODULE NAME-IEAJAB00. MFT ATT' I250 05528021 * ROUTINE NAME-ABTERM. MODULE NAME-IEAJAB00 MFT AC M1444 05536021 * ATTACH WITHOUT TRACE OPTION AC M1444 05544021 AGO .SKIPC AC M1444 05552021 .SATTWT ANOP AC M1444 05560021 TITLE 'ROUTINE NAME-ABTERM. MODULE NAME-IEANAM00-MFT ATT' AC M1444 05568021 * ROUTINE NAME-ABTERM. MODULE NAME-IEANAM00 MFT ATTACH AC M1444 05576021 * WITH TRACE OPTION AC M1444 05584021 .SKIPC ANOP 05600018 * 05800018 * 06000018 * FUNCTION: ABTERM FORCES THE SPECIFIED TASK TO TERMINATE ABNORMALLY 06200018 * 06400018 * 06600018 * ENTRY: THE ABTERM ENTRY POINT NAME IS IEA0AB00. THE ENTRY POINT AD 06800018 * DRESS CAN BE RETRIEVED FROM THE COMMUNICATIONS VECTOR TABLE WITH 07000018 * THE FOLLOWING INSTRUCTION SEQUENCE: 07200018 * L I, 16 07400018 * L I, CVTBTERM(0,I) 07600018 * ABTERM MAY BE ENTERED USING A BRANCH INSTRUCTION. THE INPUT PARAME 07800018 * TERS ARE DESCRIBED IN THE NEXT TOPIC. 08000018 * ABTERM MUST BE ENTERED IN SUPERVISOR STATE, WITH SUPERVISOR PROTEC 08200018 * ION KEY, AND WITH INPUT/OUTPUT AND EXTERNAL INTERRUPTS DISABLED. 08400018 * 08600018 * 08800018 * INPUT: ON ENTRY TO ABTERM, REGISTERS 0,1 AND 14 MUST HAVE BEEN INI 09000018 * IALIZED AS FOLLOWS: 09200018 * . REGISTER 0 MUST CONTAIN THE TCB ADDRESS OF THE TASK TO BE TERMIN 09400018 * ATED. 09600018 * . REGISTER 1, BIT 0 MUST BE SET IF A DUMP IS REQUESTED. 09800018 * . REGISTER 1,BITS 8-31 MUST CONTAIN THE COMPLETION CODE. 10000018 * . REGISTER 14 MUST CONTAIN THE RETURN ADDRESS. 10200018 * 10400018 * 10600018 * OUTPUT: THE CONTENTS OF REGISTERS 0,1 AND 15 ARE DESTROYED. 10800018 * 11000018 * 11200018 * EXTERNAL REFERENCES: ABTERM REFERENCES CONTROL BLOCKS, SWITCHES, A 11400018 * ND LOCATIONS IN THE RESIDENT NUCLEUS, OF WHICH THE FOLLOWING IS A 11600018 * LIST - 11800018 * . THE TCB OF THE TASK TO BE TERMINATED. 12000018 * . CONTROL BLOCKS WHICH ARE POINTED TO FROM THE TASK CONTROL BLOCK 12200018 * (THE REQUEST BLOCK QUEUE FOR EXAMPLE). 12400018 * . LOCATION SVCSAV (THE SVC SAVE AREA). 12600018 * . LOCATION SVCOPSW (THE SVC OPSW). 12800018 * . LOCATION SVF+1 (THE TYPE I SVC SWITCH). 13000018 * 13200018 * 13400018 * EXITS: IF THE TCB ADDRESS IN REGISTER 0 DOES NOT SPECIFY A TASK WH 13600018 * ICH IS CAPABLE OF BEING ABNORMALLY TERMINATED, ABTERM ENTERS THE W 13800018 * AIT STATE USING THE LPSW INSTRUCITON. OTHERWISE ABTERM EXITS BY BR 14000018 * ANCHING TO THE ADDRESS SPECIFIED IN REGISTER 14. 14200018 * 14400018 * 14600018 * ERROR MESSAGES: NONE 14800018 * 15000018 * 15200018 * NOTES: A TYPE I SVC ROUTINE MUST BRANCH TO ABTERM TO TERMINATE THE 15400018 * CURRENTLY DISPATCHED TASK. 15600018 AIF (&ATT NE 1).SKIPD AC M1444 15800021 * ANY SVC ROUTINE MAY BRANCH TO ABTERM TO 16000018 * TERMINATE A TASK WHICH IS NOT THE CURRENTLY DISPATCHED TASK. 16200018 .SKIPD ANOP 16400018 * ABTERM ASSUMES THAT THE TCB ADDRESS IN REGISTER 0 IS ALWAYS VALID. 16600018 * 16800018 * 17000018 * OPERATION - 17200018 * ABTERM TESTS A FLAG IN THE TCB TO SEE IF THE SPECIFIED TASK CAN 17400018 * BE ABNORMALLY TERMINATED. IF IT CAN NOT, ABTERM ENTERS THE WAIT 17600018 * STATE USING THE LPSW INSTRUCTION. 17800018 * 17810021 * ROLLOUT OPTION REMOVED IN RELEASE 21 21372 17850021 * 18000021 AIF (&ATT NE 1).SKIPF AC M1444 18900021 * IF THE TASK TO BE TERMINATED IS NOT THE CURRENTLY DISPATCHED 19800018 * TASK, ABTERM MODIFIES THE CONTENTS OF LOCATIONS NEW AND NEW+4 20000018 * TO INSURE THAT THIS TASK SUBSEQUENTLY WILL BE DISPATCHED. 20200018 * IF THE TASK TO BE TERMINATED IS THE CURRENTLY DISPATCHED TASK, AND 20400018 .SKIPF ANOP 20600018 * IF THE SVC TYPE I SWITCH IS SET, ABTERM PERFORMS THE FOLLOWING FUN 20800018 * CTIONS: 21000018 * . SAVES THE RIGHT HALF OF THE SVC OPSW. 21200018 * . REPLACES THE RIGHT HALF OF THE SVC OPSW WITH THE ADDRESS OF AN 21400018 * SVC ABEND INSTRUCTION. 21600018 * . TURNS OFF THE SVC TYPE I NESTING SWITCH. 21800018 * . LOADS REGISTERS 0 AND 1 FROM THE SVC TYPE I SAVE AREA. 22000018 * . RESTORES REGISTERS 22200018 * . EXITS 22400018 * OTHERWISE ABTERM PERFORMS THE FOLLOWING FUNCTIONS - 22600018 * . LOCATES THE CURRENT RB ON THE RB QUEUE OF THE TASK TO BE 22800018 * TERMINATED. 23000018 * . SAVES THE WAIT COUNT FROM THIS RB AND REPLACES IT WITH A ZERO 23200018 * WAIT COUNT. 23400018 * . SAVES THE RIGHT HALF OF THE RESUME PSW IN THIS RB. 23600018 * . REPLACES THE RIGHT HALF OF THE RESUME PSW WITH THE ADDRESS OF AN 23800018 * SVC ABEND INSTRUCTION. 24000018 * . RESTORES REGISTERS 24200018 * . EXITS 24400018 * 24600018 * 24800018 * REMARKS - CERTAIN UNIQUE SEPARATOR CARDS ARE USED THROUGH OUT 25000018 * THE ASSEMBLY,AS FOLLOWS: 25200018 * 1. THE FOLLOWING CARD PRECEDES AND SUCCEEDS A 25400018 * CONDITIONAL ASSEMBLY INSTRUCTION. 25600018 *CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 25800018 * 2. THE FOLLOWING CARD PRECEDES AND SUCCEEDS A 26000018 * TEMPORARY OR DEBUGGING INSTRUCTION OR SET OF 26200018 * INSTRUCTIONS. 26400018 *TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT 26600018 * 3. THE FOLLOWING CARD PRECEDES AND SUCCEEDS A 26800018 * SEQUENCE OF 'DC-ORG' OPERATIONS REQUIRED TO SIMULATE 27000018 * INSTRUCTIONS WITH ADDRESSES AS EXTERNAL SYMBOLS WHERE 27200018 * THESE SYMBOLS ARE KNOWN TO BE WITHIN THE FIRST 4095 27400018 * BYTES OF THE MACHINE. 27600018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 27800018 * 28000018 * 28200018 EXTRN IEACVT DAR 28400018 EXTRN IEA0IO02 28800018 EXTRN SVCSAV 29000018 EXTRN SVF 29200018 *TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT 29400018 EXTRN IEATCBP 29600018 *TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT 29800018 TCBREG EQU 12 30000018 GONGREG EQU 13 30200018 TCBFLGS EQU 28 30400018 SVREG EQU 13 30600018 TCBMSS EQU 24 30800018 COMREG EQU 1 31000018 WKREG EQU 10 31200018 TCBDSP EQU 35 1 DISPATCHING PRIORITY 31400018 TCBCMP EQU 16 31600018 SPSW EQU 0 ABEND SAVE AREA DISPLACEMENT L00B 31800018 SVCOPSW EQU 32 32000018 RETREG EQU 14 32200018 PRBREG EQU 11 32400018 TCBRBP EQU 0 32600018 SWT EQU 4 ABEND SAVE AREA DISPLACEMENT L00B 32800018 XRBWT EQU 28 33000018 XRBPSW EQU 16 33200018 ADREG EQU 15 33400018 PIOPSW EQU 40 33600018 TCBNSTAE EQU 160 DISP TO STAE FIELD IN TCB STAC 33800018 STAEREC EQU X'80' STAE RECURSION FLAG STAC 34000018 CVTPOST EQU X'58' CVT DISP FOR POST AC M1701 34050021 * ENTERED FLAG AC M1701 34100021 * 34200018 * 34400018 DS 0D 34600018 BALR ADREG,0 ESTABLISH ADDRESSABILITY. 34800018 USING *,ADREG 35000018 START BC 15,TBEG DAR 35200018 AIF (&TRACE EQ 1).SKARE 35400018 BRBACK BCR 15,RETREG BRANCH BACK 35600018 .SKARE ANOP 35800018 AIF (&ATT NE 1).SKSIRB I250 35840019 DC V(ABENTRY) . DEQ ENTRY FOR ABEND I250 35880019 AGO .SIRB I250 35920019 .SKSIRB ANOP I250 35960019 AIF (&ONETASK NE 1).NOSIRB M4997 35961019 EXTRN IEEMSIRB M4997 35970019 DC A(IEEMSIRB) 36000018 AGO .TBEG M4997 36010019 .NOSIRB ANOP M4997 36011019 DC F'0' UNUSED M4997 36020019 .SIRB ANOP I250 36100019 DC V(IEA0EQ01) 36400018 DC V(LEQC) 36600018 AIF (&TRACE EQ 1).SKARF 36800018 DC A(BRBACK) 37000018 AGO .SKARG 37200018 .SKARF ANOP 37400018 TRSTOP DC V(TRSTOPER) 37600018 .SKARG ANOP 37800018 AIF (&TRACE EQ 1).SKDMP 20048 37860020 DC F'0' . UNUSED IF NO TRACE 20048 37890020 AGO .SKDUMP1 20048 37920020 .SKDMP ANOP 20048 37950020 EXTRN IEATRCST . 20048 37980020 DC A(IEATRCST) . PTR TO TRACE NOP SWITCH 20048 38010020 .SKDUMP1 ANOP 20048 38040020 AIF (&ATT EQ 1).ASE 20048 38070020 EXTRN SIRB 20048 38100020 ERRTCB DC A(SIRB) 20048 38130020 AGO .TASK 20048 38160020 .ASE ANOP 20048 38190020 EXTRN IEASETCB 20048 38220020 ERRTCB DC A(IEASETCB) 20048 38250020 .TASK ANOP 20048 38280020 DC A(TASKW) EP FOR TASK DISP 20048 38310020 * ROUTINE USED BY SVC DUMP 20048 38340020 DC V(IEAARAM4) . PTR TO RAM LIST CE A35198 38360000 DC V(SVRBPOOL) . PTR TO ABEND SVRB POOL CE A35198 38380000 .TBEG ANOP 38400018 TBEG DS 0C 38600018 *TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT 38800018 *TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT 39000018 MVC 16(4),CVTADDR REFRESH CVT PTR AT LOC 16 DAR 39200018 STM 0,15,ASAV . SAVE ALL REGS ON ENTRY A39387 39400021 AIF (&ONETASK NE 1).SKIPCP DAR 39600018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 39800018 * L TCBREG,IEATCBP+4 OBTAIN TCB ADDR DAR 40000018 * 40200018 DC AL4(IEATCBP+4) . DAR 40400018 ORG *-4 . DAR 40600018 BALR TCBREG,0 . DAR 40800018 ORG *-2 . DAR 41000018 DC X'58' . DAR 41200018 ORG *+3 . DAR 41400018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 41600018 AGO .SKIPK DAR 41800018 .SKIPCP ANOP DAR 42000018 LR TCBREG,0 GET TCB ADDRESS FROM REG 0. 42200018 LA TCBREG,0(TCBREG) CLEAR HIGH ORDER BYTE 42400018 C TCBREG,XSNTTCB IS IT XSNT AREA LOADING TASK? I275 42420019 BC 7,CONTINUE NO, CONTINUE IN ABTERM I275 42440019 LM 0,14,ASAV . RESTORE REGS FOR DISPATCHER AB A49851 42450021 L 15,XSNTRTN . BRANCH TO RE-INSTATE XSNT AREA AB A49851 42460021 BR 15 . LOADING TASK AB A49851 42480021 XSNTRTN DC V(IEAXERR) I275 42500019 XSNTTCB DC V(IEAXSNT) I275 42520019 CONTINUE EQU * I275 42540019 * VALIDITY CHECK TCB ADDRESS DAR* 42600018 EX TCBREG,TEST TCB ADDRESS ON FULL WORK DAR 42800018 BZ TCBOK BOUNDARY-YES, BRANCH DAR 43000018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 43200018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 43400018 * TM SVF+1,X'F0' IS TYPE ONE SWITCH ON DAR 43600018 DC AL4(SVF+1) . DAR 43800018 ORG *-4 . DAR 44000018 DC X'91F0' . DAR 44200018 ORG *+2 . DAR 44400018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 44600018 BO SVC YES, BRANCH DAR 44800018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 45000018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 45200018 * LA RETREG,IEA0DS RETURN TO DISPATCHER DAR 45400018 EXTRN IEA0DS DAR 45600018 DC AL4(IEA0DS) DAR 45800018 ORG *-4 . DAR 46000018 DC X'41E0' . DAR 46200018 ORG *+2 47200020 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 48200020 BR RETREG 49200020 SVC EQU * 50200020 MVC 37(3),ABPSW+1 SET OLD SVC PSW TO SVC 13 51200020 L 14,CVTADDR . GET CVT ADDRESS AC M1701 51250021 NI CVTPOST(14),X'7F' TURN OFF 'POST AC M1701 51300021 * ENTERED' FLAG AC M1701 51350021 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 52200020 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 53200020 * L RETREG,DISMISS 54200020 EXTRN DISMISS 55200020 DC AL4(DISMISS) 56200020 ORG *-4 57200020 DC X'41E0' 58200020 ORG *+2 59200020 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 60200020 BR RETREG 61200020 TEST TM HEX3,X'00' FULL WORD BOUNDARY TEST DAR 65800018 HEX3 DC X'03' DAR 66000018 DS 0H DAR 66200018 TCBOK EQU * DAR 66400018 * ROLLOUT OPTION REMOVED IN RELEASE 21 21372 66450021 .SKIPK ANOP 66800018 ABNXT TM TCBFLGS+1(TCBREG),X'80' IS ABEND BIT ON... 69400018 BC 7,ASET YES. BRANCH TO ASET. 69800018 TM TCBNSTAE(TCBREG),STAEREC Q.STAE PROCESS PROGRESSING STAC 70000018 BO ASETA YES, TAKE BRANCH STAC 70200018 TM TCBFLGS+1(TCBREG),X'20' ABTERM BIT 70400018 BC 7,ARSTR 70600018 ASETA ST COMREG,TCBCMP(TCBREG) STORE COMPLETION CODE STAC 70800018 ASET OI TCBFLGS+1(TCBREG),X'21' SET ASYNCHR + ABTERM BIT 71000018 L SVREG,TCBMSS(TCBREG) PICK UP ADDR OF BUCKET 71200018 SH SVREG,EIGHT ADJUST ADDRESS FOR ABEND SAVE AREA L00B 71400018 AIF (&ONETASK EQ 1).SKIPH 71600018 TM TCBFLGS+1(TCBREG),X'80' SECOND ENTRY I250 71640019 BZ SKIPST NO-BRANCH I250 71680019 ST COMREG,4(SVREG) STORE SECOND COMP CODE I250 71720019 SKIPST EQU * I250 71760019 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 72000018 * LM 10,11,IEATCBP LOAD CONTENTS OF NEW AND OLD. 72200018 * 72400018 DC AL4(IEATCBP) 72600018 ORG *-4 72800018 DC X'98AB' 73000018 ORG *+2 73200018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 73400018 CR PRBREG,TCBREG IS TCBREG EQ TO OLD 73600018 BC 8,NPOST IF YES, SKIP POSTING 73800018 LTR WKREG,WKREG IS NEW 0 74000018 BC 8,A1 IF YES, CHK OLD 74200018 CLC TCBDSP(1,WKREG),TCBDSP(TCBREG) PRIORITY OF NEW TO TCBRG 74400018 BC 2,AIO IF HI, SKIP 74600018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 74800018 * ST TCBREG,IEATCBP STORE TCBADDR IN NEW 75000018 * 75200018 AS DC AL4(IEATCBP) 75400018 ORG *-4 75600018 DC X'50C0' 75800018 ORG *+2 76000018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 76200018 BC 15,AIO BRANCH TO IO ROUTINE 76400018 A1 CLC TCBDSP(1,PRBREG),TCBDSP(TCBREG) OLD TO TCB PRIORITY 76600018 BC 4,AS OLD IS LOW 76800018 BC 15,AIO 77000018 NPOST DS 0C 77200018 .SKIPH ANOP 77400018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 77600018 * MVI IEA0IO02+1,X'00' TURN OFF DSEUDO DISABLE SWITCH 77800018 * 78000018 DC AL4(IEA0IO02+1) 78200018 ORG *-4 78400018 DC X'9200' 78600018 ORG *+2 78800018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 79000018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 79200018 * TM SVF+1,X'F0' IS TYPE I SVC SWITCH ON... X 79400018 * X 79600018 DC AL4(SVF+1) X 79800018 ORG *-4 X 80000018 DC X'91F0' X 80200018 ORG *+2 X 80400018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 80600018 BC 8,AIO NO. BRANCH TO AIO. 80800018 MVC SPSW(4,SVREG),SVCOPSW+4 YES. SAVE RIGHT HALF SVC OPSW. 81000018 MVC SVCOPSW+5(3),ABPSW+1 REPLACE IT WITH ADDR OF ABCON. 81200018 ********TURN OFF NESTING SWITCH GOES HERE ***************************** 81400018 MVI SVCOPSW+2,X'00' TURN OFF SVC NESTING SWITCH 81600018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 81800018 * LM 0,1,SVCSAV RESTORE ORIGINAL REGS 0 AND 1. X 82000018 * X 82200018 DC AL4(SVCSAV) X 82400018 ORG *-4 X 82600018 DC X'9801' X 82800018 ORG *+2 X 83000018 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 83200018 B LEAV0 TYPE 1 SVC ONLY A28408 83210019 ARSTR LR 0,TCBREG RESTORE TCB ADDRESS 83400018 LEAV0 EQU * A28408 83410019 LM 10,13,ASAV+40 . RESTORE WORK REGISTERS A39387 83600021 BCR 15,RETREG RETURN TO CALLER 84000018 AIF (&TRACE EQ 1).SKARH 84010019 AGO .SKARI 84200018 .SKARH ANOP 84400018 * THE TRACE TABLE WILL BE TURNED OFF IN ABEND A27771 84600019 .SKARI ANOP 85000018 AIO L PRBREG,TCBRBP(TCBREG) 85200018 AIF (&ATT NE 1).SKATT I250 85250019 NI NONDISP(TCBREG),0 I250 85260021 NC TCBNDFL(3,TCBREG),RMSNDSP RESET ALL 2NDARY ND AD M0623 85270021 * FLGS EXCEPT RMS/SER AD M0623 85290021 BC 8,TCBDISP NO RMS/SER NON-DISP AD M0623 85310021 OI NONDISP(TCBREG),X'01' IND TASK PERM ND AD M0623 85330021 TCBDISP EQU * AD M0623 85350021 NONDISP EQU 33 I250 85400019 TCBNDFL EQU 173 I250 85450019 .SKATT ANOP I250 85500019 MVI XRBWT(PRBREG),X'00' ZERO RB WAIT COUNT 85600018 MVC SPSW(4,SVREG),XRBPSW+4(PRBREG) SAVE RESUME PSW 85800018 MVC XRBPSW+5(3,PRBREG),ABPSW+1 REPLACE IT WITH ADDR OF ABCON 86000018 BC 15,ARSTR BRANCH TO RESTORE REGS 86200018 RMSNDSP DC X'100000' MASK USED TO CLEAR ALL BUT THE AD M0623 86250021 * RMS/SER SECONDARY NON-DSP FLGS AD M0623 86300021 DS 0F 86350021 ASAV DC 16F'0' A39387 86400021 ABPSW DC A(ABCON) 86600018 CVTADDR DC A(IEACVT) ADDRESS OF CVT DAR 86800018 EIGHT DC H'8' ABEND SAVE AREA ADJUST CONSTANT L00B 87000018 ABCON SVC 13 87200018 DROP ADREG 87250020 AIF ('&ONETASK' EQ '1').SKIPL 87300018 EJECT 20048 87310021 * 20048 87320021 * EQUATES FOR DUMP APPENDAGES 20048 87330021 * 20048 87340021 R1 EQU 1 20048 87350021 R2 EQU 2 20048 87360021 R3 EQU 3 20048 87370021 R4 EQU 4 20048 87380021 R7 EQU 7 20048 87390021 R8 EQU 8 87400021 R9 EQU 9 20048 87410021 R10 EQU 10 20048 87420021 R11 EQU 11 20048 87430021 R12 EQU 12 20048 87440021 R13 EQU 13 20048 87450021 R14 EQU 14 20048 87460021 R15 EQU 15 20048 87470021 X00 EQU X'00' 20048 87480021 X01 EQU 1 20048 87490021 X02 EQU X'02' 20048 87500021 X03 EQU 3 20048 87510021 X04 EQU X'04' 20048 87520021 X05 EQU X'05' 20048 87530021 X06 EQU X'06' 20048 87540021 X07 EQU X'07' 20048 87550021 X08 EQU X'08' 20048 87560021 X10 EQU X'10' 20048 87570021 X13 EQU X'13' 20048 87580021 X0C EQU X'0C' 87590021 X0E EQU X'0E' 20048 87600021 X20 EQU X'20' 20048 87610021 X28 EQU X'10' 20048 87620021 X40 EQU X'40' 20048 87630021 X80 EQU X'80' 20048 87640021 XF3 EQU X'F3' 20048 87650021 XFF EQU X'FF' 20048 87660021 X400 EQU X'0400' 20048 87670021 CCOFF EQU X'00' 20048 87680021 NOP EQU 3 20048 87690021 TIC EQU X'08' 20048 87700021 SLI EQU X'20' 20048 87710021 INVSTOFF EQU X'5F' 20048 87720021 CCON EQU X'80' 20048 87730021 COMCHAN EQU X'40' 20048 87740021 PCION EQU X'08' 20048 87750021 PCIOFF EQU X'F7' 20048 87760021 REGA EQU 10 20048 87770021 REGB EQU 11 20048 87780021 REGC EQU 12 20048 87790021 REGD EQU 13 20048 87800021 RDSECT EQU 2 BASE REG FOR DSECT 20048 87810021 RBASE EQU 15 BASE REG FOR CE APPENDAGE 20048 87820021 WKRGA EQU 10 WORK REGISTER 20048 87830021 EOFIND EQU X'40' END OF FILE MASK 20048 87840021 EODIND EQU X'80' END OF DATA MASK 20048 87850021 PDIND EQU X'08' PARTIAL DUMP MASK 20048 87860021 PCIIND EQU X'08' PCI INDICATOR 20048 87870021 HDRIND EQU X'80' HEADER RECORD INDICATOR 20048 87880021 CVTPROT EQU 183 20048 87890021 PROTECT EQU X'80' 20048 87900021 OPTB EQU 183 20048 87910021 DMPTECT EQU X'40' 20048 87920021 * EQUATES FOR TASK DISPATCHABILITY SETTING ROUTINE 20048 87930021 CVTHEAD EQU X'A0' 20048 87940021 TCBTCB EQU X'74' 20048 87950021 TCBRG EQU 4 20048 87960021 CVTDAR EQU X'48' 20048 87970021 CVTLOCK EQU X'80' 20048 87980021 TCBDAR EQU X'AC' M1338 87990021 ALL EQU X'FF' 20048 88000021 TCBNDSVC EQU X'20' M1338 88010021 HDROFF EQU X'DF' MASK TO TURN HDR BIT OFF 20048 88020021 NDBIT EQU X'01' 20048 88030021 ABTERM EQU 52 20048 88040021 CSWPTR EQU X'40' CSW ADDRESS PTR 88050021 WRITE EQU X'1D' 88060021 EJECT 20048 88070021 ***************************************************************** 20048 88080021 * 20048 88090021 * ROUTINE NAME - DMPCEAPP - CHANNEL END APPENDAGE FOR SVC DUMP 20048 88100021 * 20048 88110021 * CHANGE LEVEL = 0 20048 88120021 * 20048 88130021 * FUNCTION: THE CHANNEL END APPENDAGE IS ENTERED UNDER ONE 20048 88140021 * OF THREE CONDITIONS: 20048 88150021 * 20048 88160021 * 1. THE CYCLINDER IS FULL AND A NOP WAS EXECUTED. 20048 88170021 * THIS CONDITION IS NORMAL. 20048 88180021 * 20048 88190021 * 2. A PCI INTERRUPT WAS LOST AND A NOP WAS EXECUTED 20048 88200021 * GENERATING A CHANNEL END CONDITION. THIS IS 20048 88210021 * IS ABNORMAL BUT RECOVERABLE. 20048 88220021 * 20048 88230021 * 3. THE ABNORMAL END APPENDAGE REINITIALIZED THE 20048 88240021 * CHANNEL PROGRAM WITH NO CHAINING OR PCI IN ORDER20048 88250021 * TO TRY TO RECOVER FROM AN ABNORMAL CONDITION. 20048 88260021 * THIS IS ABNORMAL BUT RECOVERABLE. 20048 88270021 * (NOTE: THE CHANNEL END APPENDAGE IS ALSO ENTERED 20048 88280021 * AFTER THE ABNORMAL END APPENDAGE HAS BEEN 20048 88290021 * ENTERED AND BEFORE ERPS HAVE RECEIVED CONTROL 20048 88300021 * FROM IOS. THIS IS WHY CE APP MUST CHECK CSW 20048 88310021 * FOR ERROR CONDITIONS AND IF PRESENT, EXIT 20048 88320021 * TO IOS FOR ERP PROCESSING.) 20048 88330021 * 20048 88340021 * THE FOLLOWING ACTIONS ARE PREFORMED BY THE APPENDAGE 20048 88350021 * 20048 88360021 * 1. WHEN THE CE APP IS ENTERED DUE TO THE 1ST CASE 20048 88370021 * ABOVE THEN THE CYCLINDER ADDRESS(CC) IS UPDATED 20048 88380021 * TO THE NEXT CYCLINDER, THE TRACK ADDRESS(HH) IS 20048 88390021 * RESET TO ZERO AND THE COUNT AND KEY FIELDS ARE 20048 88400021 * UPDATED, AS WELL AS THE DATA ADDRESS IN CCW5 20048 88410021 * (NOTE: THE CCW CHAIN IS SHOWN IN THE 'TABLES 20048 88420021 * AND CONTROL BLOCKS' SECTION BELOW.) THEN 20048 88430021 * THE CE APP EXITS TO IOS FOR RESTART OF THE 20048 88440021 * CHANNEL PROGRAM. 20048 88450021 * 20048 88460021 * 2. IF THE CE APP IS ENTERED DUE TO THE SECOND CASE 20048 88470021 * THEN THE IOB SEARCH ARGUMENT IS UPDATED TO 20048 88480021 * SEARCH ON THE LAST RECORD WRITTEN AND RESTART 20048 88490021 * THE CHANNEL PROGRAM TO REWRITE THE LAST RECORD. 20048 88500021 * (NOTE: IF THE PCI FROM CCW8 IS LOST, THEN THE RESTART 20048 88510021 * CCW CHAIN WILL RESTART SUCH THAT THE DATA 20048 88520021 * ADDRESS WILL BE IN CCW5.) 20048 88530021 * 20048 88540021 * 3. IF THE CE APP IS ENTERED DUE TO THE THIRD CASE THEN 20048 88550021 * THE CE APP RETURNS TO IOS. 20048 88560021 * 20048 88570021 EJECT 88580021 * 20048 88590021 * ENTRY POINT NAME - DMPCEAPP. 20048 88600021 * 20048 88610021 * SVC USAGE - NONE 20048 88620021 * 20048 88630021 * INPUT - THE FOLLOWING REGISTERS ARE AVAILABLE TO THE APPENDAGE 20048 88640021 * ON ENTRY FROM IOS. 20048 88650021 * 20048 88660021 * REGISTER 1 -- ADDRESS OF RQE FOR THE CHANNEL PROGRAM 20048 88670021 * 20048 88680021 * REGISTER 2 -- ADDRESS OF IOB 20048 88690021 * 20048 88700021 * RESISTER 3 -- ADDRESS OF DEB 20048 88710021 * 20048 88720021 * REGISTER 4 -- ADDRESS OF DCB 20048 88730021 * 20048 88740021 * REGISTER 7 -- ADDRESS OF UCB 20048 88750021 * 20048 88760021 * REGISTER 14 -- RETURN REGISTER 20048 88770021 * 20048 88780021 * REGISTER 15 -- ADDRESS OF ENTRY POINT TO APPENDAGE 20048 88790021 * 20048 88800021 * OUTPUT - NONE 20048 88810021 * 20048 88820021 * ENTRY POINTS - DMPCEAPP - NORMAL ENTRY FROM IOS 20048 88830021 * 20048 88840021 * EXIT POINTS: 20048 88850021 * 20048 88860021 * 1. TO IOS FOR RESTARTING CCW CHAIN 20048 88870021 * 20048 88880021 * 2. TO IOS WHEN DUMP IS COMPLETE 20048 88890021 * 20048 88900021 * 20048 88910021 * 20048 88920021 EJECT 88930021 * TABLE AND CONTROL BLOCKS REFERENCED - 20048 88940021 * 20048 88950021 * 1. IOB 20048 88960021 * 20048 88970021 * 2. DMPDSECT -- SEE DSECT FOR FORMAT 20048 88980021 * 20048 88990021 * 3. DEB 20048 89000021 * 20048 89010021 * 4. CCW CHAIN: 20048 89020021 * 20048 89030021 ***************************************************************** 20048 89040021 * 20048 89050021 * CCW NO. COMMAND FLAGS LENGTH 20048 89060021 * 20048 89070021 ***************************************************************** 20048 89080021 * 1 READ HA SKP, CC 5 20048 89090021 * 2 SRCH ID EQ (MULTI TRK) CC 5 20048 89100021 * 3 TIC TO 2 1 20048 89110021 * 4 WRITE CKD DC 12 20048 89120021 * 5 WRITE CKD PCI, CC 1024 20048 89130021 * 6 NOP/TIC TO 2 SLI 1 20048 89140021 * 7 WRITE CKD DC 12 20048 89150021 * 8 WRITE CKD PCI, CC 1024 20048 89160021 * 9 NOP/TIC TO 2 OR 4 SLI 1 20048 89170021 ***************************************************************** 20048 89180021 * 20048 89190021 * 20048 89200021 * NOTE: THESE TABLES AND CONTROL BLOCKS ARE REFERENCED BY ALL 20048 89210021 * THREE APPENDAGES 20048 89220021 * 20048 89230021 EJECT 89240021 * 20048 89250021 * 20048 89260021 * ROUTINE NAME - DMPAEAPP - ABNORMAL END APPENDAGE 20048 89270021 * 20048 89280021 * CHANGE LEVEL = 0 20048 89290021 * 20048 89300021 * FUNCTION THE ABNORMAL END APPENDAGE IS ENTERED WHEN AN 20048 89310021 * ERROR CONDITION OCCURS. THE APPENDAGE IS ENTERED 20048 89320021 * PRIOR TO ERP PROCESSING, AND, IF RECOVERY IS 20048 89330021 * UNSUCCESSFUL, FOLLOWING ERP PROCESSING. THE 20048 89340021 * CHANNEL PROGRAM MUST BE REINITIALIZED TO ALLOW 20048 89350021 * RETRY. 20048 89360021 * 20048 89370021 * AT INITIAL ENTRY THE PERMANENT ERROR FLAG IN THE 20048 89380021 * IOB IS CHECKED TO DETERMINE IF AN ERROR HAS BECOME20048 89390021 * PERMANENT. IF SO, THE APPENDAGE WILL RETURN TO 20048 89400021 * IOS TO WRITE AN EOF RECORD. THE SVC DUMP MAINLINE20048 89410021 * ROUTINE WILL DETERMINE AN ERROR OCCURED BY TESTING20048 89420021 * THE BITS IN THE CONTROL BLOCKS FOR ERROR INDICATOR20048 89430021 * 20048 89440021 * IF IT IS NOT A PERMANENT ERROR, A TEST IS MADE TO 20048 89450021 * DETERMINE IF CHANNEL DATA CHECK HAS OCCURED. 20048 89460021 * THIS WOULD INDICATE A WRITE FROM INVALID STORAGE. 20048 89470021 * IN THIS CASE, THE CHANNEL PROGRAM IS SET UP TO 20048 89480021 * REWRITE THE FAILING RECORD. BIT 2 OF THE STORAGE 20048 89490021 * KEY IS SET TO 1 INDICATING INVALID DATA CONTAINED 20048 89500021 * IN THE RECORD. CCW5'S DATA ADDRESS IS SET TO ZERO 20048 89510021 * SO THAT THE FAILING STORAGE IS NOT ACCESSED AGAIN.20048 89520021 * THE CHANNEL PROGRAM IS SET UP TO RESTART BY 20048 89530021 * SETTING THE SEARCH ARGUMENT OF THE LAST RECORD 20048 89540021 * WRITTEN. RETURN IS TO IOS FOR RESTART. 20048 89550021 * 20048 89560021 * FOR ERROR CONDITIONS OTHER THAN CHANNEL DATA CHECK20048 89570021 * THE FOLLOWING STEPS ARE TAKEN: 20048 89580021 * 20048 89590021 * 1. SET CCW6 AND CCW9 TO NOP. 20048 89600021 * 2. SET SEARCH ARGUMENT TO LAST RECORD WRITTEN 20048 89610021 * 3. TURN OFF PCI FLAGS IN CCW5 AND CCW8 20048 89620021 * 4. RESET ANY 'NEXT ADDRESS' CALCULATIONS OF THE 20048 89630021 * PCI APPENDAGE. LOGIC WILL REQUIRE CHECKS 20048 89640021 * TO DETERMINE IF THE ERROR OCCURED AFTER A 20048 89650021 * PCI AND IN WHICH HALF OF THE CHANNEL PROGRAM 20048 89660021 * THE ERROR OCCURED. IF THE ERROR OCCURED 20048 89670021 * BEFORE THE PCI NO REINITIALIZING OF THE 20048 89680021 * ADDRESS IS NECESSARY. IF THE ERROR OCCURED 20048 89690021 * AFTER THE PCI INTERRUPT, THEN THE ADDRESS 20048 89700021 * IN THE CHANNEL PROGRAM HAS TO BACKED UP 20048 89710021 * TO BEFORE THE PCI WAS PROCESSED. 20048 89720021 EJECT 89730021 * 5. IF THE ERROR OCCURS AFTER CCW6, THEN THE NEXT 20048 89740021 * ADDRESS COMPUTATIONS HAVE TO BE SET UP FOR 20048 89750021 * USE WITH CCW4 AND CCW5. 20048 89760021 * 6. RETURN TO IOS FOR ERP PROCESSING 20048 89770021 * 20048 89780021 * 20048 89790021 * ENTRY POINT NAME - DMPAEAPP. 20048 89800021 * 20048 89810021 * EXTERNAL REFERENCES - NONE 20048 89820021 * 20048 89830021 * SVC USAGE - NONE 20048 89840021 * 20048 89850021 * INPUT - SAME AS CHANNEL END APPENDAGE 20048 89860021 * 20048 89870021 * OUTPUT - NONE 89880021 * 20048 89890021 * EXITS - 1. TO IOS FOR RESTART 20048 89900021 * 20048 89910021 * 2. TO IOS TO WRITE EOF RECORD AFTER PERMENATE ERROR 20048 89920021 * 20048 89930021 * TABLES AND CONTROL BLOCKS - SAME AS FOR CE APP 20048 89940021 * 20048 89950021 * 20048 89960021 ***************************************************************** 20048 89970021 EJECT 89980021 * 20048 89990021 ***************************************************************** 20048 90000021 * 20048 90010021 * 20048 90020021 * ROUTINE NAME - DMPPCIAP - PROGRAM CONTROLLED INTERRUPT APPENDAGE20048 90030021 * 20048 90040021 * CHANGE LEVEL = 0 20048 90050021 * 20048 90060021 * FUNCTION: ON INITIAL ENTRY TO THE PCI APPENDAGE CCW6 20048 90070021 * AND CCW9 ARE SET TO NOP AND THE COMMAND CHAIN BIT 20048 90080021 * IN CCW6 IS TURNED OFF. THE PCI APPENDAGE WILL 20048 90090021 * UPDATE THE COUNT AND KEY FIELD LOCATED IN THE 20048 90100021 * CONTROL BLOCK COMPLEX AND WILL ADJUST CCW DATA 20048 90110021 * ADDRESSES TO WRITE THE NEXT BLOCK OF STORAGE. 20048 90120021 * 20048 90130021 * IF THE PCI WAS GENERATED AT CCW5, THE PCI BIT IN 20048 90140021 * CCW5 WILL BE TURNED OFF. CCW6 WILL HAVE THE 20048 90150021 * COMMAND CHAIN BIT TURNED ON IF ANOTHER BLOCK WILL 20048 90160021 * FIT ON THE SAME TRACK. THE HEAD NUMBER WILL BE 20048 90170021 * INCREMENTED AND CCW6 WILL BE SET TO TIC IF THE 20048 90180021 * LAST BLOCK ON THE LAST TRACK HAS BEEN WRITTEN. 20048 90190021 * PCI IS TURNED ON IN CCW8. THE NOP AND COMMAND 20048 90200021 * CHAIN BIT OFF CONDITION WILL BE LEFT IN AFFECT 20048 90210021 * IF THE LAST BLOCK ON THE LAST TRACK HAS BEEN 20048 90220021 * WRITTEN. 20048 90230021 * 20048 90240021 * IF THE PCI WAS GENERATED AT CCW8, THE PCI BIT IS 20048 90250021 * TURNED OFF IN CCW8 AND CCW9 WILL BE SET TO TIC TO 20048 90260021 * CCW4 IF ANOTHER BLOCK WILL FIT ON THE SAME TRACK. 20048 90270021 * THE PCI BIT IN CCW5 WILL BE TURNED ON. IF THE 20048 90280021 * TRACK IF FULL, THE HEAD NUMBER IS INCREMENTED, AND20048 90290021 * CCW9 WILL TIC TO CCW2. IF THE CYLINDER IS FULL, 20048 90300021 * THE NOP IS LEFT IN EFFECT. 20048 90310021 * 20048 90320021 * THE PCI APPENDAGE PERFORMS 'NEXT ADDRESS' 20048 90330021 * DETERMINATION AFTER RESETTING THE CHANNEL PROGRAM 20048 90340021 * DASD EXTENTS WILL BE VALIDATED TO ENSURE THAT 20048 90350021 * ANOTHER WRITE WILL NOT VIOLATE EXTENTS. IN AN 20048 90360021 * MP SYSTEM, FSSEMAP IS CHECKED TO ENSURE THAT 20048 90370021 * STORAGE TO BE DISPLAYED IS ON-LINE. IF NOT ON- 20048 90380021 * LINE, 256K IS BYPASSED. ALL CALCULATED VALUES 20048 90390021 * ARE SAVED FOR THE NEXT PCI ENTRY. 20048 90400021 * 20048 90410021 * ENTRY POINT NAME - DMPPCIAP 20048 90420021 * 20048 90430021 * EXTERNAL REFERENCES - NONE 20048 90440021 * 20048 90450021 * SVC USAGE - NONE 20048 90460021 * 20048 90470021 * INPUT - SAME AS CHANNEL END APPENDAGE 20048 90480021 * 20048 90490021 * OUTPUT - NONE 20048 90500021 * 20048 90510021 * EXITS - 1. TO IOS FOR RESTART 20048 90520021 * 20048 90530021 * TABLES AND CONTROL BLOCKS - SAME AS FOR CE APP 20048 90540021 * 20048 90550021 * 20048 90560021 ***************************************************************** 20048 90570021 EJECT 90580021 * 20048 90590021 * APPENDAGES FOR DUMP SVC 20048 90600021 * 20048 90610021 ENTRY DMPCEAPP 20048 90620021 ENTRY DMPAEAPP 20048 90630021 ENTRY DMPPCIAP 20048 90640021 * 20048 90650021 DMPCEAPP DS 0H 20048 90660021 USING DMPIOB,RDSECT 20048 90670021 USING *,RBASE 20048 90680021 USING DEBSECT,R3 DEB DSECT 20048 90690021 TM DMPIOBCS+X03,XF3 TEST FOR ERROR CONDITION 20048 90700021 BCR X05,RETREG RETURN IF ERROR CONDITIONS AD A49311 90710021 TM DMPIOBCS+X04,X'7F' .TEST FOR ERROR @PD66507 90720021 BCR X05,RETREG RETURN IF ERROR CONDITIONS AD A49311 90730021 TM DMPFLAG2,X'40' . IF 3330 NO-PCI @PD64143 90731021 BZ DMPCEAP2 . PROCESS MODE, @PD64143 90732021 STM R14,R15,NOPCISR . GO PERFORM PSEUDO @PD64143 90733021 LA R15,DMPPCIAP . PCI PROCESSING @PD64143 90734021 BAL R14,DMPPCIA2-DMPPCIAP(,R15) NOW @PD64143 90735021 LM R14,R15,NOPCISR-*(R14) RELOAD REGS @PD64143 90736021 DMPCEAP2 EQU * . @PD64143 90737021 TM DMPFLAG,EODIND TEST FOR END OF DATA 20048 90740021 BO EODNORM IF ON, GO WRITE EOF RCD 20048 90750021 TM DMPCCWF5,PCIIND TEST PCI BIT IN CCW5 20048 90760021 BO X08(RETREG) RETURN TO IOS 90770021 TM DMPCCWF8,PCIIND TEST PCI BIT ON IN CCW8 20048 90780021 BO X08(RETREG) RETURN TO IOS 90790021 L R10,DMPTICCW GET PTR TO NEXT CCW 90800021 LA R10,X00(R10) CLEAR HIGH BYTE 90810021 LA R11,DMPCCW4 SET UP DSECT FOR USE 90820021 CR R10,R11 TEST FOR WHICH CCW CHAIN 90830021 BNE DMPCEAND OK CONDITION 90840021 LA R11,DMPCCW7 SET UP DSECT FOR USE 90850021 DMPCEAND EQU * 90860021 ST R11,DMPTICCW SAVE NEXT CCW CHAIN 90870021 MVI DMPTICCW,TIC MAKE CCW A TIC 90880021 USING DMPCCWX,R11 90890021 OI DMPCCWB+X04,PCION+COMCHAN TURN PCI FLAG ON 90900021 TM DMPFLAG2,X80 TEST FOR PCI IN CONTROL FIRST 90910021 BNO DMPCRND PCI DID NOT UPDATE CCHHR 90920021 NI DMPFLAG2,X'7F' TURN OFF FLAG 90930021 L R12,DMPCCWA GET PTR TO KEY AREA 90940021 BAL R13,DMPUPDAT GO BACK UP IOB SRCH ID 90950021 MVC DMPCCWB+X01(3),DMPADSAV+X01 MOVE DATA FIELD 20048 90960021 MVI DMPCCWC,NOP NOP ENDING CCW 90970021 B PCINOT8 DO NOT UPDATE CCHHR 90980021 DMPCRND EQU * 90990021 BAL REGD,DMPINGRE GO TO UPDATE ROUTINE 20048 91000021 SR R9,R9 ZERO IOS REGISTER 91010021 TM DMPFLAG,X'90' TEST FOR END OF DUMP 20048 91020021 BO EODNORM GO WRITE EOF RECORD 20048 91030021 L R11,DMPTICCW GET NEXT CCW CHAIN 91040021 L R9,X00(R11) PICK UP KEY AREA 91050021 MVC DMPCCWB+X01(3),DMPADSAV+X01 MOVE DATA FIELD 20048 91060021 BAL R13,DMPCICON GO TO SUBROUTINE FOR STOR KEY 91070021 BAL R13,DMPCERTN GO TO TRK SETUP RTN 91080021 B EODS IF END,BRANCH 20048 91090021 B PCINOT8 UPDATE CYCLINDER ADDR 91100021 B PCINOT8 UPDATE CYCLINDER ADDR 91110021 PCINOT8 BAL R13,DMPSWTCH GO TO ADDR SWITCH RTN 91120021 B 8(RETREG) RETURN 20048 91130021 NOPCISR DC 2A(0) . REGISTER SAVE AREA @PD64143 91135021 DROP R11 91140021 DROP RBASE 91150021 EJECT 20048 91160021 DMPAEAPP DS 0H 20048 91170021 USING *,RBASE SET UP APP BASE 20048 91180021 USING DMPCCWX,R10 91190021 TM DMPIOBEC,X'7F' TEST FOR PERM IO ERROR 20048 91200021 BC 14,TSTHDR IF SO,BRANCH 20048 91210021 LA R10,DMPCCW4 LOAD ADDRESS OF CCW4 20048 91220021 L R11,DMPIOBF3 LOAD 1ST 3 BYTES OF CSW 20048 91230021 LA R11,X00(R11) CLEAR HIGH BYTE 91240021 CLR R11,R10 CHECK FOR CCW 4&5 OR 8&9 20048 91250021 BH GTCCW4 PROBLEM IS NOT A SRCH OR READ HA 91260021 L R10,DMPTICCW GET PTR TO CURRENT CHAIN 91270021 NI DMPCCWB+X04,PCIOFF TURN PCI BIT OFF 91280021 BR R14 RETURN TO IOS AD A49311 91290021 GTCCW4 EQU * 91300021 LA R10,DMPCCW7 LOAD ADDRESS OF CCW7 20048 91310021 CLR R11,R10 CHECK FOR CCW 4&5 OR 8&9 20048 91320021 BH CCW8 IF 8OR 9,BRANCH 20048 91330021 LA R10,DMPCCW4 SET UP FOR DSECTS 91340021 LA R11,DMPCCW7 SET UP FOR DSECTS 91350021 B NOTHDR IF NOT BRANCH 20048 91360021 CCW8 EQU * 91370021 LA R11,DMPCCW4 91380021 NOTHDR EQU * 91390021 TM DMPFLAG2,X80 DID PCI UPDATE FOR CYL END 91400021 BO SEPARATE IF SO PROCESS DIFFERENTLY 91410021 TM DMPCCWB+X04,PCIIND TEST IF PCI ON 91420021 BNO RESTART 91430021 NI DMPCCWB+X04,PCIOFF TURN PCI BIT OFF 91440021 CHDATACK EQU * 91450021 TM DMPIOBCS+X04,X08 TEST FOR CHANNEL DATA CHECK 91460021 BCR 14,R14 RETURN TO IOS AD A49311 91470021 TM DMPFLAG,HDRIND TEST FOR HEADER RECORD 91480021 BCR 1,R14 RETURN TO IOS IF HDR RCD AD A49311 91490021 L R12,X00(R10) GET CORRECT KEY AREA 91500021 USING DMPWRWD,R12 91510021 OI DMPFLGKY,X20 SET INVALID STORAGE BIT 91520021 DROP R12 91530021 SR R12,R12 ZERO WORK REG 91540021 ST R12,DMPCCWB STORE ADDRESS FOR WRITE 91550021 MVI DMPCCWB,WRITE MAKE CCW A WRITE 91560021 B X08(R14) RETURN TO IOS 91570021 RESTART EQU * 91580021 OI DMPFLAG2,X80 TURN ON UPDATE BIT FOR CE APP 91590021 ST R10,DMPTICCW SAVE NEXT CCW CHAIN PTR 91600021 NI X0C(R11),PCIOFF TURN PCI OFF IN NEXT CCW 91610021 BAL R13,DMPSWTCH SWITCH PTRS FOR RESTART 91620021 SEPARATE EQU * 91630021 L R12,DMPCCWA GET PTR TO KEY AREA 91640021 BAL R13,DMPUPDAT GO TO PCI CONTROL ROUT 91650021 MVI DMPCCWC,NOP INSURE THAT CE APP GETS CONTROL 91660021 B CHDATACK FINISH REST OF PROCESSING 91670021 DROP R10 91680021 TSTHDR EQU * 91690021 L R10,DMPTICCW PICK UP CURRENT CHAIN 91700021 L R11,X00(R10) PICK UP CURRENT KEY 91710021 USING DMPWRWD,R11 91720021 OI DMPFLAG,X08+X80 SET PARTIAL DUMP FLAG AND EOD 91730021 TM DMPFLGKY,HDRIND TEST FOR HDR RECORD 91740021 BCR X01,R14 RETURN TO IOS 91750021 OI DMPFLAG,X08 SET PARTIAL DUMP FLAG ON 91760021 DROP R11 91770021 DROP RBASE 91780021 EODNORM EQU * 20048 91790021 BALR R10,X00 ESTABLISH ADDRESSIBILITY 20048 91800021 USING *,R10 20048 91810021 LA R11,DMPDCB GET ADDRESS OF SYS1.DUMP DCB 20048 91820021 LA R4,X00(R4) CLEAR HIGH BYTE OF DCB REG 20048 91830021 CR R11,R4 COMPARE TO DUMPING DCB 20048 91840021 BCR X07,R14 RETURN IF NOT SYS1.DUMB DCB 20048 91850021 L R11,DMPTICCW GET CURRENT CHAIN PTR 91860021 TM DMPFLAG,X08 TEST FOR COMING FROM AE APP 91870021 BO DMPEODAD COMING FROM AE APP 91880021 L R9,X00(R11) SET UP FOR NEXT ROUTINE 91960021 MVI DMPTICCW,TIC SET UP TIC COMMAND CODE 91970021 CLI X13(R7),X08 IS THE DUMPING DEVICE=2314? 20048 91980021 BNE EODNRMA NO, GO TO WRITE EOF 20048 91990021 * THIS CODE IS NEEDED WHEN THERE IS NOT ENOUGH ROOM LEFT 20048 92000021 * ON A 2314 TRACK TO WRITE AN EOF RECORD (WHEN SIX RECORDS 20048 92010021 * HAVE BEEN WRITTEN). SHOULD SIX RECORDS BE WRITTEN THEN 20048 92020021 * WE MUST UPDATE CCHHR TO THE NEXT TRACK OR CYLINDER WHERE 20048 92030021 * APPROPIATE. 20048 92040021 BAL R13,DMPCERTN GO TO UPDATE RTN 92050021 B EODS 92060021 B EOFNRMB GO FINISH EOF HANDLING 92070021 B EOFNRMB GO FINISH EOF HANDLING 92080021 EOFNRMB EQU * 92090021 L R11,DMPTICCW PICK UP CURRENT CHAIN PTR 92100021 L R9,X00(R11) GET CURRENT KEY AREA 92110021 B EODNRMB GO FINISH EOF HANDLING 92120021 EJECT 92130021 USING DMPWRWD,R9 92140021 EODNRMA IC R11,DMPRID PICK UP RCD NO. IN KEY 20048 92150021 LA R11,X01(R11) INCREMENT RCD NO. 20048 92160021 STC R11,DMPRID STORE RCD NO. INTO IOB 20048 92170021 LA R11,X01(R11) INCREMENT RCD NO. 20048 92180021 STC R11,DMPR STORE RCD NO. INTO KEY 20048 92190021 B EODNRMB GO FINISH EOF HANDLING 92200021 DMPEODAD EQU * 92210021 L R9,X00(R11) SET UP FOR NEXT ROUTINE 92220021 EODNRMB EQU * 20048 92230021 LA R11,DMPAPPAD GET ADDR OF NOP INSTR 20048 92240021 ST R11,DEBAPPAD STORE ADDR INTO DEB 20048 92250021 XC DMPKEYL(X03),DMPKEYL CLEAR FIELD FOR EOF RECORD 20048 92260021 MVI DMPCCW4+X04,SLI TURN ON SILLY BIT 20048 92270021 OI DMPFLAG,X80 SET END OF DUMP FLAG 20048 92280021 SR R9,R9 CLEAR IOS REGISTER 92290021 B X08(R14) RETURN TO IOS 20048 92300021 EODS OI DMPFLAG,EOFIND+PDIND SET EOF & PART DMP INDIC 20048 92310021 BR R14 RETURN TO IOS 20048 92320021 DROP R9 92330021 DROP R10 92340021 EJECT 92350021 DMPPCIAP EQU * 20048 92360021 USING *,R15 20048 92370021 TM DMPFLAG2,X'40' . IF 3330 NO-PCI @PD64143 92371021 BCR 1,R14 . WANTED THEN RETURN @PD64143 92372021 DMPPCIA2 EQU * . PSEUDO PCI ENTRY @PD64143 92373021 * FOR NON-PCI 3330 @PD64143 92374021 * PROCESSING @PD64143 92375021 L R12,CSWPTR GET PTR TO CURRENT CCW 92380021 LA R12,X00(R12) ZERO HIGH ORDER BYTE 92390021 L R13,DMPAPTR1 GET PTR TO NOP CCW 92400021 CR R12,R13 TEST TO SEE IF NORMAL PCI 92410021 BE DMPNOPCI IF EQUAL BRANCH TO NORMAL PROCESSING 92420021 LA R13,X08(R13) SEE IF NOP WAS EXECUTED 92430021 CR R12,R13 TEST FOR NOP 92440021 BE DMPNOPCI HANDLE AS NORMAL PCI PROCESSING 92450021 BR R14 HANDLE PCI AS NOP CONDITION 92460021 DMPNOPCI EQU * 92470021 BAL R13,DMPINGRE GO TO RTN TO INCREMENT ADDRSAVE 20048 92480021 SR R9,R9 CLEAR IOS REGISTER 92490021 TM DMPFLAG,X'90' TEST FOR END OF DUMP 20048 92500021 BNO DMPNOVR 92510021 NI DMPCCWF8,PCIOFF 20048 92520021 NI DMPCCWF5,PCIOFF TURN PCI FLAG OFF IF ON 20048 92530021 BR R14 RETURN TO IOS 92540021 DMPNOVR EQU * 92550021 TM DMPCCWF5,PCION IS THE PCI FLAG ON IN CCW5 20048 92560021 LA R9,DMPCC2 SET UP DSECT 92570021 BO DMPCIONW TAKE THIS BRANCH IF PCI ON 20048 92580021 LA R9,DMPCC1 SET UP DSECT 92590021 DMPCIONW EQU * 92600021 BAL R13,DMPCICON GO TO STORAGE KEY RTN 92610021 LA R10,DMPCCW7 GET ADDR OF CCW CHAIN TO WORK 20048 92620021 USING DMPCCWX,R10 20048 92630021 LA R12,DMPCCW6 SET UP FOR LATER USE 20048 92640021 TM DMPCCWF5,PCION IS THE PCI FLAG ON IN CCW5 20048 92650021 BO DMPPCION TAKE THIS BRANCH IF PCI ON 20048 92660021 NI DMPFLAG,HDROFF SET HDR RECORD INDIC OFF 20048 92670021 LA R10,DMPCCW4 IF CCW8 WAS THE PCI THEN THIS 20048 92680021 * CODE IS USED TO SET UP DSECT 20048 92690021 LA R12,DMPCCW9 SAVE FOR LATER USE 20048 92700021 NI DMPCCWF8,PCIOFF 20048 92710021 DMPPCION EQU * 20048 92720021 NI DMPCCWF5,PCIOFF TURN PCI FLAG OFF IF ON 20048 92730021 BAL R13,DMPCERTN GO TO TRK SETUP RTN 92740021 B X00(R14) RETURN TO IOS 92750021 B DMPPCIAB END OF TRACK SITUATION 92760021 B DMPCEND END OF CYCL SITUATION 92770021 B DMPCIFIX NORMAL 92780021 DMPCEND EQU * 92790021 OI DMPFLAG2,X80 SET ON BIT TO TELL CE THAT 92800021 * PCI UPDATED CCHHR FOR EOC 92810021 BR R14 RETURN TO IOS 92820021 DMPPCIAB EQU * 92830021 LA R11,DMPCCW2 SET UP FOR TC TO SEARCH 20048 92840021 ST R11,0(R12) SAVE CCW2 ADDR IN APPR CCW 20048 92850021 B DMPCIOVR BRANCH AROUND STORE 92860021 DMPCIFIX EQU * 92870021 ST R10,X00(R12) SAVE PTR TO NEXT CHAIN 92880021 DMPCIOVR EQU * 92890021 ST R10,DMPTICCW SAVE NEXT CCW CHAIN 92900021 OI DMPCCWB+4,PCION+COMCHAN 20048 92910021 MVC DMPCCWB+1(3),DMPADSAV+1 20048 92920021 MVI DMPCCWC,NOP SET NEXT CCW TO A NOP 92930021 MVI X00(R12),TIC TIC TO NEXT 92940021 BAL R13,DMPSWTCH GO TO SWITCH NEXT AND CURRENT 92950021 BR R14 20048 92960021 DROP R3 92970021 DROP R10 92980021 DMPINGRE EQU * 20048 92990021 BALR R9,0 SET UP ADDRESABILITY 20048 93000021 USING *,R9 20048 93010021 LM R10,R11,DMPADSAV PICK UP CURR ADDR AND END ADDR 20048 93020021 LA R10,X400(R10) INCREMENT BY 1K 20048 93030021 CR R10,R11 IS THIS THE END OF DUMP 20048 93040021 ST R10,DMPADSAV SAVE NEW ADDR 20048 93050021 BCR 4,R13 RETURN IF NOT END OF DUMP 20048 93060021 TM DMPFLAG,X01 IS THIS A LIST REQUEST 93070021 BO DMPLIST CONT AS LIST REQUEST 93080021 DMPAOVER OI DMPFLAG,X'90' SET EOD AND SUCCESS BITS 20048 93090021 BR R13 RETURN TO MAINLINE 20048 93100021 DMPLIST EQU * 20048 93110021 L R12,DMPPLSTP GET STORAGE LIST POINTER 20048 93120021 DMPLISTN EQU * 20048 93130021 TM 4(R12),X'80' IS THIS END OF LIST 20048 93140021 BO DMPAOVER END OF DUMP EXIT 20048 93150021 LA R12,8(R12) UPDATE TO NEXT ENTRIES 20048 93160021 TM 0(R12),X'40' . IS THIS ENTRY VALID @PD61924 93170021 BO DMPLISTN NO, SEE IF END OF LIST 20048 93180021 ST R12,DMPPLSTP SAVE PRESENT PTR TO STOR. LIST 20048 93190021 LM R10,R11,0(R12) PICK UP NEW START/STOP ADDRESS 20048 93200021 STM R10,R11,DMPADSAV STORE NEW START/STOP ADDRESSES 20048 93210021 MVI DMPEND,00 . CLEAR POSSIBLE @PD61924 93213021 * 'END-OF-LIST' INDICATOR @PD61924 93216021 SR R9,R9 ZERO IOS REGISTER 20048 93220021 BR R13 RETURN TO CALLER 20048 93230021 DROP R9 20048 93240021 EJECT 20048 93250021 DMPCERTN EQU * 93260021 USING DEBSECT,R3 20048 93270021 USING DMPWRWD,R9 93280021 ST R8,DMPASAV2 SAVE IOS REGISTER 93290021 BALR R8,X00 ESTABLISH BASE 93300021 USING *,R8 93310021 SR R11,R11 ZERO WORK REGISTER AD A51118 93312021 CLC DMPRID(1),DMPDINFO IS THIS END OF TRACK 20048 93320021 BNL DMPCERT1 YES, TEST FOR END OF CYCLINDER 20048 93330021 MVC DMPCC(X04),DMPCCID RESTORE CCHH TO KEY 93340021 IC R11,DMPRID GET NO. OF RECORD JUST WRITTEN 20048 93360021 LA R11,1(R11) INCREMENT BY ONE 20048 93370021 STC R11,DMPRID SAVE RECORD NO. IN SEARCH FIELD 20048 93380021 LA R11,1(R11) INCREMENT BY ONE 20048 93390021 STC R11,DMPR SAVE NEW RECORD NO. IN KEY FLD 20048 93400021 L R8,DMPASAV2 RESTORE IOS REGISTER 93410021 SR R9,R9 ZERO IOS REGISTER 93420021 B X0C(R13) RETURN TO MAINLINE 93430021 DMPCERT1 EQU * 93440021 CLC DMPHHID+1,DMPDINFO+1 CYLINDER FULL? 20048 93450021 BNL CYCFULL IF SO,BRANCH 20048 93460021 IC R11,DMPHHID+1 SET UP TO INCREMENT HEAD 20048 93470021 LA R11,1(R11) INCREMENT BY ONE 20048 93480021 STC R11,DMPHH+1 STORE INT KEY 20048 93490021 STC R11,DMPHHID+1 STORE INTO SEARCH ID 20048 93500021 CYCTEST1 CLC DMPCCID(4),DEBENDCC TEST FOR END OF EXTENT 20048 93510021 BH CYCENDDP . RETURN TO MAINLAIN AD A54862 93520021 CYCTEST2 MVI DMPRID,X00 ZERO RCD NO. IN SEARCH ID 20048 93530021 MVI DMPR,X01 SET RCD NO IN KEY 20048 93540021 L R8,DMPASAV2 RESTORE IOS REGISTER 93550021 SR R9,R9 ZERO IOS REGISTER 93560021 B X04(R13) IF END,BRANCH 20048 93570021 CYCFULL EQU * . AD A51118 93580021 IC R11,DMPCCID . GET 1ST HALF OF CYL ADDR AD A51118 93590021 SLL R11,8 . PREPARE TO GET REMAINDER AD A51118 93600021 IC R11,DMPCCID+1 . COMPLETE CYL ADDR AD A51118 93610021 LA R11,X01(R11) . INCREMENT BY 1 AD A51118 93612021 STH R11,DMPCC . UPDATE CYL ADDR FOR NXT WR AD A51118 93614021 MVC DMPCCID(X02),DMPCC . UPDATE CYL ADDR IN AD A51118 93616021 * SEARCH ARGUMENT AD A51118 93618021 NI DMPHH+1,X'00' SET HH TO 0 20048 93620021 NI DMPHHID+1,X'00' SET HH TO 0 20048 93630021 CLC DMPCCID(4),DEBENDCC TEST FOR END OF EXTENT 20048 93640021 BH CYCENDDP RETURN TO MAINLAIN AD A60156 93650021 LA R13,X04(R13) THIS MAKES A RETURN OF 8 INSTEAD OF 4 93660021 B CYCTEST2 TEST FOR END OF EXTENT 93670021 CYCENDDP EQU * 93680021 L R8,DMPASAV2 RESTORE IOS REGISTER 93690021 SR R9,R9 ZERO IOS REGISTER 93700021 BR R13 RETURN TO MAINLINE 93710021 DROP R8 93720021 EJECT 20048 93730021 DMPCICON EQU * 20048 93740021 ST R8,DMPASAV2 SAVE IOS REGISTER 93750021 BALR R8,X00 ESTABLISH ADDRESSABILITY 93760021 USING *,R8 93770021 SR R12,R12 ZERO WORK REGISTER 20048 93780021 L R11,X10 GET ADDR OF CVT 20048 93790021 TM OPTB(R11),PROTECT IS PROTECTION IN SYSTEM 20048 93800021 BO DMPPROT YES, GO TO GET STORAGE KEY 20048 93810021 LA R12,DMPTECT SET UP FOR NO STOR KEY 20048 93820021 B DMPASPRO GO STORE INTO KEY 20048 93830021 DMPPROT EQU * 20048 93840021 ISK R12,R10 GET STOR KEY OF ADDR TO DUMP 20048 93850021 SRL R12,X03 MOVE TO POSITION FOR STORING 20048 93860021 DMPASPRO EQU * 93870021 ST R10,DMPFLGKY STORE ADDR INTO KEY FIELD 93880021 STC R12,DMPFLGKY STORE PROTECT KEY 93890021 L R8,DMPASAV2 RESTORE IOS REGISTER 93900021 BR R13 RETURN 93910021 DROP R9 93920021 DROP R8 93930021 DMPSWTCH EQU * 93940021 L R11,DMPAPTR1 GET CURRENT PTR 93950021 L R12,DMPAPTR2 GET NEXT PTR 93960021 ST R11,DMPAPTR2 MAKE CURRENT NEXT 93970021 ST R12,DMPAPTR1 MAKE NEXT CURRENT 93980021 MVI DMPTICCW,TIC TIC TO NEXT 93990021 BR R13 RETURN 94000021 * 94010021 DMPUPDAT EQU * 94020021 USING DMPWRWD,R12 94030021 MVC DMPCCID(X04),DMPCC MOVE LAST KEY TO SRCH ID 94040021 IC R9,DMPR PICK UP LAST RCD 94050021 BCTR R9,X00 DECREMENT BY ONE 94060021 STC R9,DMPRID STORE IN SEARCH ARGUMENT 94070021 SR R9,R9 ZERO IOS REGISTER 94080021 BR R13 RETURN TO MAINLAIN 94090021 DROP R12 94100021 EJECT 20048 94110021 * THIS ROUTINE IS ENTERED FROM BOTH LOADS OF SVC DUMP AND 20048 94120021 * AND TO TURN OFF THE TRACE OPTION (OR TURN ON THE OPTION) 20048 94130021 * IF THE TRACING FACILITY IS INCLUDED 20048 94140021 DS 0H 20048 94150021 TASKW EQU * 20048 94160021 USING *,R11 20048 94170021 L R1,CMTCB GET COMMM TASK ADDR 20048 94180021 L R9,ERRTSK GET ERROR PROC ADDR 20048 94190021 L R10,CVTHEAD(R3) TOP TASK ADDR 20048 94200021 NOTPRIM EQU * 20048 94210021 L R10,TCBTCB(R10) GET NEXT TASK ADDR 20048 94220021 CR R10,TCBRG THIS CURRENT TASK 20048 94230021 BE NOTPRIM YES - SKIP 20048 94240021 LTR R10,R10 NO MORE TASKS 20048 94250021 BZ TRACE YES - BRANCH 20048 94260021 CR R10,R1 THIS COM TASK 20048 94270021 BE NOTPRIM YES - SKIP 20048 94280021 CR R10,R9 ERR PROC TASK 20048 94290021 BE NOTPRIM YES - SKIP 20048 94300021 TM CVTDAR(R3),CVTLOCK SETTING ND 20048 94310021 BO SETNON YES - BRANCH 20048 94320021 NI TCBDAR+X02(R10),ALL-TCBNDSVC SET SECOND BIT 20048 94330021 NC TCBDAR+X01(3,R10),TCBDAR+X01(R10) STILL ND 20048 94340021 BNZ NOTPRIM YES - BRANCH 20048 94350021 NI TCBFLGS+5(R10),ALL-NDBIT TURN OFF PRIM ND 20048 94360021 B NOTPRIM GET NEXT TASK 20048 94370021 SETNON OI TCBDAR+X02(R10),TCBNDSVC SET SECONDARY ND BIT 20048 94380021 OI TCBFLGS+5(R10),NDBIT SET PRIMARY ND BIT 20048 94390021 B NOTPRIM GET NEXT TASK 20048 94400021 TRACE EQU * 20048 94410021 AIF (&ONETASK NE 0).NGTF 96550321 * 21014 96550621 * THE FOLLOWING CODE WILL DETERMINE WHETHER GTF IS TO BE 21014 96550921 * SUSPENDED OR RESUMED AND TAKE THE APPROPRIATE ACTION. 21014 96551221 * 21014 96551521 L CVTREG,CVTPTR . GET CVT POINTER 21014 96551621 TM CVTGTFST(CVTREG),CVTGTFS . Q - IS GTF ACTIVE 21014 96551821 BNO NOGTF . NO-SKIP THIS CODE 21014 96552121 TM CVTGTFST(CVTREG),CVTFORM . Q - IS FORMAT REQUESTED 21014 96552421 BCR D7,R7 . NO-RETURN TO CALLER 21014 96552721 TM CVTDAR(3),CVTLOCK .Q - SVCDUMP FINISHED 21014 96553021 BNO GTFON YES-GO ENABLE GTF AB A65775 96553321 * THIS SECTION SUSPENDS GTF TRACE AT START OF SVCDUMP 21014 96553621 TM TCBFLGS+1(R10),TCBGTOFM . Q - GTF SUSPENDED AD A53006 96553921 BCR 1,R7 . YES-RETURN TO CALLER AB A60174 96554221 OI TCBFLGS+1(R10),TCBGTOFM . FLAG GTF DISABLED AD A53006 96554521 HOOK EID=IHLMSVOF . SUSPEND GTF 21014 96554821 BR R7 . RETURN 21014 96555121 * THIS SECTION WILL RESUME GTF TRACE AT COMPLETION OF SVCDUMP 21014 96555421 GTFON TM TCBFLGS+1(R10),TCBGTOFM . Q - GTF SUSPENDED AD A53006 96555721 BCR 8,R7 . NO-RETURN AB A60174 96556021 NI TCBFLGS+1(R10),ALL-TCBGTOFM . FLAG GTF RESUMED AD A53006 96556321 HOOK EID=IHLMSVON . RESUME TRACE 21014 96556621 BR R7 . RETURN 21014 96556921 CVTREG EQU 3 21014 96557021 CVTGTFST EQU X'EC' 21016 96557121 TCBGTOFM EQU X'10' . 21014 96557321 CVTGTFS EQU X'C0' . 21014 96558521 CVTFORM EQU X'08' . 21014 96558621 CVTPTR EQU 16 . 21014 96560721 D7 EQU 7 . 21014 96563221 D8 EQU 8 . 21014 96565321 NOGTF EQU * 21014 96567421 ***** ***** 21014 96569521 ***** END OF GTF MODIFICATIONS 21014 96571621 ***** ***** 21014 96573721 .NGTF ANOP 96575821 AIF (&TRACE NE 1).DMP1 20048 96617921 .DMP2 ANOP 20048 96657921 TM CVTDAR(R3),CVTLOCK TRACE OFF 20048 96697921 L R1,ABTERM(R3) GET CVTBTERM 20048 96737921 L R1,24(R1) GET PTR TO TRNOP 20048 96777921 BNO TOFF YES - BRANCH 20048 96817921 OI 1(R1),X'F0' TURN OFF TRACE 20048 96857921 BR R7 RETURN TO SVC DUMP 20048 96897921 TOFF EQU * 20048 96937921 NI 1(R1),X'0F' TURN ON TRACE 20048 96977921 .DMP1 ANOP 20048 97017921 BR R7 RETURN TO SVC DUMP 20048 97057921 DS 0F 20048 97097921 CMTCB DC V(IEACMTCB) COM TASK TCB ADDR 20048 97137921 AIF (&ATT EQ 1).YESSE 20048 97177921 ERRTSK DC F'0' NO SYS ERR W/O ATTACH 20048 97217921 AGO .FRED 20048 97257921 .YESSE ANOP 20048 97297921 ERRTSK DC A(IEASETCB) SYS ERR TCB ADDR 20048 97337921 .FRED ANOP 20048 97377921 EJECT 20048 97417921 SCBDUMP 20048 97457921 DEBSECT DSECT 20048 97497921 DEBTCB DS CL4 ADDRESS OF TCB 20048 97537921 DEBLINK DS CL4 ADDR OF PREV. DEB 20048 97577921 DS CL4 20048 97617921 DEBFLGS DS CL1 20048 97657921 DS CL3 20048 97697921 DS CL4 20048 97737921 DEBPRIOR DS CL1 PRIORITY 20048 97777921 DS CL3 20048 97817921 DEBDCB DS CL4 ADDRESS OF DCB 20048 97857921 DEBAPPAD DS CL4 ADDR OF I/O APPEND TABLE 20048 97897921 DS CL2 20048 97937921 DEBUCBAD DS CL2 20048 97977921 DEBBIBUM DS CL2 BIN NUMBER 20048 98017921 DEBSTRCC DS CL2 START CYL ADDR 20048 98057921 DEBSTRHH DS CL2 START TRACK ADDR 20048 98097921 DEBENDCC DS CL2 END CYL ADDR 20048 98137921 DEBENDHH DS CL2 END TRACK ADDR 20048 98177921 DEBNOTRK DS CL2 NUMBER OF TRACKS ALLOC. 20048 98217921 * 98257921 DMPCCWX DSECT 20048 98297921 DMPCCWA DS D 20048 98337921 DMPCCWB DS D 20048 98377921 DMPCCWC DS D 98417921 * 98457921 * 98497921 DMPWRWD DSECT 98537921 DMPCC DS 2X CC CYLINDER 98577921 DMPHH DS 2X HH HEAD 98617921 DMPR DS 1X R RECORD 98657921 DMPKEYL DC X'04' KEY LENGTH 98697921 DMPDATAL DC X'0400' DATA LENGTH 98737921 DMPFLGKY DS 1X FLAG KEY 98777921 DMPADDKY DS 3X ADD KEY 98817921 .SKIPL ANOP 20048 98857921 MEND 98897921 ./ ADD SSI=03011184,SOURCE=1,NAME=IEAAPL MACRO 00020000 IEAAPL &PA 00040000 LCLB &ONETASK 00060000 &ONETASK SETB (T'&PA EQ 'O') 00080000 AIF (&ONETASK EQ 0).SKIPD 00100000 TITLE 'ROUTINE NAME - PROLOG. MODULE NAME - IEAAPL00.' 00120000 *GENERATION- DEC65,CHANGE LEVEL 000 00140000 * ROUTINE NAME - PROLOG. MODULE NAME - IEAAPL00. 00160000 AGO .SKIPE 00180000 .SKIPD ANOP 00200000 TITLE 'ROUTINE NAME - PROLOG. MODULE NAME - IEAGPL00.' 00220000 *GENERATION- DEC65,CHANGE LEVEL 000 00240000 * ROUTINE NAME - PROLOG. MODULE NAME - IEAGPL00. 00260000 .SKIPE ANOP 00280000 * 00300000 * 00320000 * FUNCTION - PROLOG DETERMINES THE TASK WITH WHICH THIS PROGRAM 00340000 * INTERRUPT IS ASSOCIATED. IT THEN SETS UP THE ABTERM LINKAGE AND 00360000 * BRANCHES TO THE ABTERM MODULE. 00380000 * 00400000 * 00420000 * ENTRY - THE PROLOG ENTRY POINT NAME IS IEA0PL00. PROLOG MAY BE 00440000 * ENTERED USING A BRANCH INSTRUCTION. PROLOG MUST BE ENTERED IN 00460000 * SUPERVISOR STATE, WITH SUPERVISOR PROTECTION KEY, AND WITH INPUT/ 00480000 * OUTPUT AND EXTERNAL INTERRUPTS DISABLED. 00500000 * 00520000 * 00540000 * INPUT - THE PROGRAM INTERRUPT OPSW MUST NOT HAVE BEEN MODIFIED. 00560000 * REGISTERS 10 THROUGH 1 AT THE TIME OF PROGRAM INTERRUPT MUST BE 00580000 * SAVED IN THE PROGRAM INTERRUPT FLIH SAVE AREA (PDSAV). 00600000 * 00620000 * 00640000 * OUTPUT - 00660000 * REGISTER 0 CONTAINS THE ADDRESS OF THE TASK TO BE ABNORMALLY 00680000 * TERMINATED. 00700000 * REGISTER 1 CONTAINS THE COMPLETION CODE. 00720000 * REGISTER 14 CONTAINS THE ADDRESS OF THE LOCATION TO WHICH ABTERM 00740000 * WILL RETURN CONTROL. 00760000 * IN THE CASE OF A PROGRAM INTERRUPT FROM A PROGRAM HAVING A 00780000 * SCHEDULED REQUEST BLOCK, 00800000 * . THE PIOPSW IS SAVED IN THE RESUME PSW SLOT IN THE REQUEST BLOCK. 00820000 * . REGISTERS 10 THROUGH 1 AT THE TIME OF PROGRAM INTERRUPT ARE 00840000 * SAVED IN THE TCB REGISTER SAVE AREA. 00860000 * 00880000 * 00900000 * 00920000 * 00940000 * EXTERNAL REFERENCES - 00960000 * . DISMISS - AN ENTRY POINT IN THE I/O FLIH. 00980000 * . IEA0DS - AN ENTRY POINT IN THE DISPATCHER 01000000 * . IEA0AB00 - THE ENTRY POINT IN ABTERM. 01020000 AIF (&ONETASK EQ 1).SKIPF 01040000 * . IEATCBLK - A TABLE WHICH CONTAINS THE ADDRESSES OF THE TCB'S. 01060000 .SKIPF ANOP 01080000 * . IORGSW - ADDRESS OF THE I/O FLIH SWITCH. 01100000 * . IEATCBP - ADDR. OF CURRENTLY DISPATCHED TASK IS AT IEATCBP+4 01120000 * . PISAV-ADDRESS OF THE PROGRAM INTERRUPT FLIH SAVE AREA 01140000 * . IEA0XE00 - AN ENTRY POINT IN THE SVC INTERRUPT HANDLER. 01160000 * . SVF - ADDRESS OF THE SVC TYPE I SWITCH. 01180000 * 01200000 * 01220000 * ERROR MESSAGES - NONE. 01240000 * 01260000 * 01280000 * NOTES - PROLOG NEED NOT RESIDE IN THE FIRST 4096 BYTES OF MAIN 01300000 * STORAGE. 01320000 * 01340000 * 01360000 * OPERATION - 01380000 * IF THE PROGRAM INTERRUPT OCCURED WITH THE I/O FLIH, PROLOG 01400000 * PERFORMS THE FOLLOWING FUNCTIONS - 01420000 * . LOADS REGISTER 0 WITH THE ADDRESS OF THE TASK A29774 01440019 * TO BE TERMINATED. A29774 01450019 * (THIS IS THE TASK WITH WHICH THE I/O IS ASSOCIATED). 01460000 * . LOADS REGISTER 1 WITH A COMPLETION CODE TO INDICATE THAT THE 01480000 * PROGRAM INTERRUPT OCCURED IN THE I/O FLIH. 01500000 * . LOADS REGISTER 14 WITH THE ADDRESS OF AN ENTRY POINT IN THE I/O 01520000 * . FLITH. 01540000 * . BRANCHES TO ABTERM. 01560000 * IF THE PROGRAM INTERRUPT OCCURED IN A TYPE 1 SVC ROUTINE, PROLOG 01580000 * PERFORMS THE FOLLOWING FUNCTIONS - 01600000 * . LOADS REGISTER 0 WITH THE ADDRESS OF THE TASK WHICH ISSUED THE 01620000 * SVC. 01640000 * . LOADS REGISTER 1 WITH A COMPLETION CODE WHICH INDICATES THAT THE 01660000 * PROGRAM INTERRUPT OCCURED IN A TYPE 1 SVC. 01680000 * . LOADS REGISTER 14 WITH THE ADDRESS OF AN ENTRY POINT IN THE SVC 01700000 * INTERRUPT HANDLER. 01720000 * . BRANCHES TO ABTERM. 01740000 * OTHERWISE PROLOG PERFORMS THE FOLLOWING FUNCTIONS - 01760000 * . LOADS REGISTER 0 WITH THE ADDRESS OF THE TASK WHICH WAS LAST 01780000 * DISPATCHED. 01800000 * . LOADS REGISTER 1 WITH A COMPLETION WHICH INDICATES THE PROGRAM 01820000 * INTERRUPT TYPE. 01840000 * . LOADS REGISTER 14 WITH THE ADDRESS OF AN ENTRY POINT IN THE 01860000 * DISPATCHER. 01880000 * . SAVES THE PROGRAM INTERRUPT OPSW IN THE RESUME PSW SLOT IN THE 01900000 * REQUEST BLOCK. 01920000 * . SAVES REGISTERS 10 THROUGH 1 AT THE TIME OF PROGRAM INTERRUPT 01940000 * IN THE TASK CONTROL BLOCK. 01960000 * . BRANCHES TO ABTERM. 01980000 * 02000000 * 02020000 *REMARKS: CERTAIN UNIQUE SEPARATOR CARDS ARE USED THROUGH OUT 02040000 * THE ASSEMBLY,AS FOLLOWS: 02060000 * 1. THE FOLLOWING CARD PRECEDES AND SUCCEEDS A 02080000 * CONDITIONAL ASSEMBLY INSTRUCTION. 02100000 *CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 02120000 * 2. THE FOLLOWING CARD PRECEDES AND SUCCEEDS A 02140000 * TEMPORARY OR DEBUGGING INSTRUCTION OR SET OF 02160000 * INSTRUCTIONS. 02180000 *TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT 02200000 * 3. THE FOLLOWING CARD PRECEDES AND SUCCEEDS A 02220000 * SEQUENCE OF 'DC-ORG' OPERATIONS REQUIRED TO SIMULATE 02240000 * INSTRUCTIONS WITH ADDRESSES AS EXTERNAL SYMBOLS WHERE 02260000 * THESE SYMBOLS ARE KNOWN TO BE WITHIN THE FIRST 4095 02280000 * BYTES OF THE MACHINE. 02300000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 02320000 * 02340000 * 02360000 EXTRN IEA0DS 02400000 EXTRN IEA0AB00 02420000 AIF (&ONETASK EQ 1).SKIPA 02440000 EXTRN IECCPL00 . A24739 02450019 AGO .SKIPA1 A24739 02460019 .SKIPA ANOP 02480000 EXTRN DISMISS . A24739 02486019 .SKIPA1 ANOP A24739 02492019 EXTRN IORGSW 02500000 EXTRN IEATCBP 02520000 EXTRN PISAV 02540000 EXTRN IEA0XE00 02560000 EXTRN SVF 02580000 ADREG EQU 15 02600000 COMREG EQU 1 02620000 AIF (&ONETASK NE 1).IO5 A24739 02630019 IOSCODE EQU X'0F1' IOS PROGRAM CHECK CODE 02640000 .IO5 ANOP A24739 02650019 PIOPSW EQU 40 02660000 SVCOPSW EQU 32 . A24739 02670019 PRBREG EQU 11 02680000 RETREG EQU 14 02700000 SVCCODE EQU X'0F2' TYPE 1 SVC PROG. CHECK 02720000 TCBGRS EQU 48 02760000 TCBRBP EQU 0 02780000 TCBREG EQU 12 02800000 TCBREG0 EQU 0 02820000 WKREG EQU 13 02840000 XRBPSW EQU 16 02860000 * 02880000 * 02900000 DS 0D 02920000 BALR ADREG,0 ESTABLISH ADDRESSABILITY. 02940000 USING *,ADREG 02960000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 02980000 * L TCBREG,IEATCBP+4 GET TCB ADDRESS FROM OLD. 03000000 * 03020000 DC AL4(IEATCBP+4) 03040000 ORG *-4 03060000 BALR TCBREG,0 03080000 ORG *-2 03100000 DC X'58' 03120000 ORG *+3 03140000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03160000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03180000 * TM IORGSW+1,X'F0' IS IO SWITCH ON... 03200000 * 03220000 DC AL4(IORGSW+1) 03240000 ORG *-4 03260000 DC X'91F0' 03280000 ORG *+2 03300000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03320000 AIF (&ONETASK EQ 1).IO2 A24739 03324019 BNZ TOIOS . HANDLE IOS PROG CK A24739 03328019 AGO .IO3 A24739 03332019 .IO2 ANOP A24739 03336019 BC 7,APIO YES,BRANCH TO APIO. 03340000 .IO3 ANOP A24739 03350019 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03360000 * TM SVF+1,X'F0' NO. IS SVC TYPE I SWITCH ON... 03380000 * 03400000 DC AL4(SVF+1) 03420000 ORG *-4 03440000 DC X'91F0' 03460000 ORG *+2 03480000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03500000 BC 7,APTI YES, BRANCH TO APTI. 03520000 L PRBREG,TCBRBP(TCBREG) NO. GET ADDR OF CURRENT RB. 03540000 MVC XRBPSW(8,PRBREG),PIOPSW MOVE PIOPSW TO RESUME PSW SLOT 03560000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03580000 * MVC TCBGRS(32,TCBREG),PDSAV SAVE REGISTERS 10-1 IN TCB. 03600000 * 03620000 ORG *+2 03640000 DC AL4(PISAV) 03660000 ORG *-6 03680000 MVI TCBGRS(TCBREG),31 03700000 ORG *-4 03720000 DC X'D2' 03740000 ORG *+5 03760000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03780000 LH COMREG,PIOPSW+2 COMPL. CODE IS INTERRUPT TYPE. 03800000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 03820000 * LA RETREG,IEA0DS ABTERM WILL RETURN TO DISPATCH. 03840000 * 03860000 DC AL4(IEA0DS) 03880000 ORG *-4 03900000 BALR RETREG,0 03920000 ORG *-2 03940000 DC X'41' 03960000 ORG *+3 03980000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 04000000 APOUT LR TCBREG0,TCBREG FINISH ABTERM LINKAGE. 04020000 SLL COMREG,12 POSITION COMPLETION CODE. 04040000 O COMREG,APAND SET DUMP BIT 04060000 L WKREG,ABTCON 04080000 BCR 15,WKREG BRANCH TO ABTERM. 04100000 * 04120000 APTI EQU * . A24739 04140019 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 04160000 * LA RETREG,IEA0XE00 ABTERM WILL RETURN TO TYPE I XT. 04180000 * 04200000 DC AL4(IEA0XE00) 04220000 ORG *-4 04240000 BALR RETREG,0 04260000 ORG *-2 04280000 DC X'41' 04300000 ORG *+3 04320000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 04340000 AIF (&ONETASK EQ 1).IO4 A24739 04360019 * 04380000 CLI SVCOPSW+3,X'00' . Q. SVC 0 A24739 04380819 BE TOIOS . YES-BRANCH A24739 04381619 CLI SVCOPSW+3,X'0F' . Q. SVC 15 A24739 04382419 BE TOIOS . YES-BRANCH A24739 04383219 .IO4 ANOP A24739 04384019 LA COMREG,SVCCODE . SET UP COMP CODE A24739 04384819 B APOUT . TO EXIT A24739 04385619 AIF (&ONETASK EQ 1).IO1 A24739 04386419 TOIOS EQU * . A24739 04387219 L WKREG,ADICCPL0 . M4075 04389219 BR WKREG . GO TO IOS PGM CK HNDLR M4075 04391219 ADICCPL0 DC A(IECCPL00) . IOS PGM CK HANDLER M4075 04393219 AGO .SKIPG A24739 04396819 .IO1 ANOP A24739 04397619 APIO DS 0H 04400000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 04420000 * LA RETREG,DISMISS RETURN ADDRESS TO DISMISS 7928 04440000 * 04460000 DC AL4(DISMISS) 7928 04480000 ORG *-4 7928 04500000 BALR RETREG,0 7928 04520000 ORG *-2 7928 04540000 DC X'41' 7928 04560000 ORG *+3 7928 04580000 *XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 04600000 LA COMREG,IOSCODE GET COMPLETION CODE. 04820000 BC 15,APOUT BRANCH TO APOUT. 04840000 .SKIPG ANOP 04890017 ABTCON DC A(IEA0AB00) 04900000 APAND DC X'800C0000' CONSTANT TO OR DUMP BIT. 04920000 MEND 05000000 ./ ADD SSI=42220008,NAME=IEAENQ,SOURCE=0 MACRO 00040020 IEAENQ &SYSTEM=,&SHARED=,&TSO= 00080020 .*2271 129600,845640,845660,845680,845720,845740,845840,846110,867830, 00140017 .* 867848,867872 11-4-68 CHANGES TO LCS CODE FOR R17 PTM 112 00160017 .*1874 117160,117320,118800,862800-863400,878500-879600,880960,881200 G00164018 REFRESHABILITY 00168018 .*1874 114600,727360,881040,881400-881700 MAINTENANCE 00172018 .* I275 00172819 .* 699700-699800,881160 I275 00173619 .* MFT TRANSIENT AREA CONTENTION PROBLEM 19088 I275 00174419 .* 19772 00175219 .*286440,357620-357648,357852,357858-357860 19772 00176019 .*OWNERSHIP 19772 00176819 .* I250 00177619 .*698100,721620,845580 19054 00178419 .*MFT ATTACH 19054 I250 00179219 .*CHANGE TO AUTO PURGE A29065 00179619 .*846710,846720 A35042 00180020 LCLB &B(3) LOCAL SWITCHES 20021 00209620 AIF ('&SYSTEM' EQ '').E1 KEYWORD MISSING 00240016 AIF ('&SHARED' EQ '').E2 KEYWORD MISSING 00300016 &B(1) SETB ('&SYSTEM' EQ 'MVT') 00360016 AIF (NOT &B(1) AND '&SYSTEM' NE 'MFT').E1 KEYWORD INVALID 00420016 &B(2) SETB ('&SHARED' EQ 'YES') 00480016 AIF (NOT &B(2) AND '&SHARED' NE 'NO').E2 KEYWORD INVALID 00540016 &B(3) SETB ('&TSO' EQ 'YES') 20021 00570020 .* 00600016 .* SWITCH &B(1) SET TO 0 - SYSTEM IS MFT-II 00660016 .* SWITCH &B(1) SET TO 1 - SYSTEM IS MVT 00720016 .* 00780016 .* SWITCH &B(2) SET TO 0 - SHARED DASD SUPPORT IS NOT INCLUDED 00840016 .* SWITCH &B(2) SET TO 1 - SHARED DASD SUPPORT IS INCLUDED 00900016 .* 00960016 .* SWITCH &B(3) SET TO 0 - TIME SHARING OPTION NOT INCLUDED 20021 00970020 .* SWITCH &B(3) SET TO 1 - TIME SHARING OPTION INCLUDED. 20021 00980020 .* 00990020 AGO .GEN1 01020016 MEXIT 01080016 .E1 MNOTE 'SYSTEM KEYWORD MISSING OR INVALID' 01140016 MEXIT 01200016 .E2 MNOTE 'SHARED KEYWORD MISSING OR INVALID' 01260016 .GEN1 ANOP 01320016 TITLE ' DEQ SERVICE ROUTINE ' 01380016 IGC048 START 01440016 SPACE 2 01500016 * ROUTINE NAME 01560016 AIF (NOT &B(1) AND NOT &B(2)).C1 01568017 AIF (NOT &B(1)).C2 01576017 AIF (&B(1) AND NOT &B(2)).C3 01584017 * IEAQENQ3-ENQ AND DEQ SERVICE ROUTINE WITH SDASD 01592017 AGO .GEN2 01600017 .C1 ANOP 01608017 * IEAGENQ1-ENQUEUE AND DEQUEUE SERVICE ROUTINE 01616017 AGO .GEN2 01624017 .C2 ANOP 01632017 * IEAGENQ2-ENQ AND DEQ SERVICE ROUTINE WITH SDASD 01640017 AGO .GEN2 01648017 .C3 ANOP 01656017 * IEAQENQ2-ENQUEUE AND DEQUEUE SERVICE ROUTINE 01664017 .GEN2 ANOP 01672017 SPACE 2 01680016 * FUNCTIONS 01740016 * 1-ENQUEUE A REQUEST FOR A SERIALLY REUSABLE RESOURCE 01800016 * 2-DEQUEUE A REQUEST FOR A SERIALLY REUSABLE RESOURCE 01860016 * 3-PERFORM SET MUST COMPLETE OR RESET MUST COMPLETE 01880017 * OPERATIONS INCLUDING SYSTEM OR STEP WIDE 01900017 * NON-DISPATCHABILITY AS REQUIRED 01920017 AIF (&B(1)).C4 01940017 * 4-PERFORM A TASK SWITCH FOR TASKS NO LONGER 01960017 * WAITING FOR A RESOURCE 01980017 AGO .GEN3 02000017 .C4 ANOP 02020017 * 4-INVOKE TASK SWITCH ROUTINE FOR TASKS 02040017 * NO LONGER WAITING FOR RESOURCE 02060017 * 5-PERFORM 'AUTO PURGE' FOR ABTERM TASKS 02080017 * 6-PURGE QUEUES AT END OF TASK OR ABEND AS REQUIRED 02100017 .GEN3 AIF (NOT &B(2)).GEN4 02120017 * -RESERVE AND RELEASE DEVICES AS REQUESTED BY THE 02140017 * RESERVE MACRO 02160017 .GEN4 ANOP 02180017 SPACE 2 02340016 * ENTRY POINT NAMES 02400016 * IGC048-DEQUEUE SERVICE ROUTINE 02460016 * IGC056-ENQUEUE SERVICE ROUTINE 02520016 * IEA0SMC-MUST COMPLETE ROUTINE 02540017 AIF (NOT &B(1)).GEN5 02560017 * IEA0EQ01-MANUAL PURGE ROUTINE 02580016 * IEAQQCB0-TOP OF MAJOR QCB QUEUE 02600017 * IEAQENA0-START OF REFRESHABLE CODE 19772 02606019 * IEAQENA1-END OF REFRESHABLE CODE 19772 02612019 AGO .GEN6 02620017 .GEN5 ANOP 02640017 * IEA0EQ01-TOP OF MAJOR QCB QUEUE 02660017 * IEA0QCB0-TOP OF MAJOR QCB QUEUE 02680017 * ABENTRY - ABEND BRANCH ENTRY 19054 02685019 * IEAGENA0-START OF REFRESHABLE CODE 19772 02690019 * IEAGENA1-END OF REFRESHABLE CODE 19772 02695019 SPACE 2 02700016 .GEN6 ANOP 02730017 * CONTAINED IN MODULE 02760016 * MODULE NAME SAME AS ROUTINE NAME 02820017 SPACE 2 02880016 * ATTRIBUTES 02940016 * RESIDENT 03000016 * REENTRANT 03060016 * REFRESHABLE 19772 03090019 * IN SUPERVISOR STATE 03120016 * TYPE 2 SVC 03180016 * DISABLED 03240016 SPACE 2 03300016 * APPLICABILITY 03360016 AIF (&B(1)).GEN7 03370017 * OPTION 2 03380017 AGO .GEN8 03390017 .GEN7 ANOP 03400017 * OPTION 4 03420016 .GEN8 AIF (NOT &B(2)).GEN9 03428017 * WITH SDASD 03436017 AGO .GEN10 03444017 .GEN9 ANOP 03452017 * WITHOUT SDASD 03460017 .GEN10 ANOP 03468017 SPACE 2 03480016 * EXTERNAL REFERENCES 03540016 * IEATCBP ADDRESS OF 'NEW' TCB 03600016 * IEA0DS DISPATCHER 03720016 AIF (NOT &B(1)).GEN11 03750017 * IEA0DS02 TASK SWITCH ROUTINE 03780016 * IEAMSTCB MASTER SCHEDULER TCB 03800017 .GEN11 ANOP 03820017 EJECT 03840016 * SVC'S USED 03900016 * SVC 3 EXIT 03930017 * SVC 10 REGISTER FORM OF GETMAIN AND FREEMAIN 03960016 * SVC 13 ABEND 04020016 SPACE 2 04080016 * INPUT 04140016 * PARAMETER LIST IN CALLERS STORAGE AREA 04200016 * BEGINNING ON A FULL WORD BOUNDRY 04260016 * PARAMETER LIST ENTRY SHOWN BELOW 04320016 SPACE 2 04380016 * MACRO EXPANSION EXAMPLES 04440016 SPACE 2 04500016 MACSEC DSECT 04560016 USING *,1 04620016 SPACE 2 04680016 IGC048 CSECT 04740016 SPACE 2 04800016 AIF (&B(1)).GEN12A 19772 04808019 IEAGENA0 EQU * 19772 04816019 AGO .GEN12B 19772 04824019 .GEN12A ANOP 19772 04832019 IEAQENA0 EQU * 19772 04840019 .GEN12B ANOP 19772 04848019 * OUTPUT FOR ENQ 04860016 * A MAJOR QUEUE CONTROL BLOCK (FORMAT BELOW) IF 04920016 * THE RESOURCE WAS NOT PREVIOUSLY REQUESTED 04980016 * AND THE MASK FIELD WAS SUCH TO ALLOW 05040016 * AN ENQUEUE. THIS ELEMENT CREATED IN SUBPOOL 255 05100016 SPACE 1 05160016 * A MINOR QUEUE CONTROL BLOCK (FORMAT BELOW) IF 05220016 * THE RESOURCE WAS NOT PREVIOUSLY REQUESTED 05280016 * AND THE MASK FIELD WAS SUCH TO ALLOW 05340016 * AN ENQUEUE. THIS ELEMENT CREATED IN SUBPOOL 255 05400016 SPACE 1 05460016 * A QUEUE ELEMENT TO REPRESENT THE REQUESTOR 05520016 * ON THE QUEUE FOR THAT RESOURCE. 05580016 * THIS ELEMENT CREATED IN SUBPOOL 255 05640016 SPACE 2 05700016 AIF (NOT &B(2)).GEN12 05707017 * WITH SDASD AND IF A RESERVE WERE ISSUED (WHICH RE- 05714017 * SULTED IN EXECUTION OF ENQUEUE), A SPECIFIED DEVICE 05721017 * WOULD BE LOGICALLY RESERVED BY AN INCREMENT IN THE 05728017 * UCB RESERVE COUNT 05735017 .GEN12 ANOP 05742017 SPACE 2 05749017 * OUTPUT FOR DEQUEUE 05760016 * THE REMOVAL OF AND FREEING OF THE SPACE 05820016 * FOR THE ELEMENTS CREATED DURING ENQUEUE. 05880016 AIF (NOT &B(2)).GEN13 05890017 * IF THE SDASD OPTION HAS BEEN SELECTED, AN EXCP WILL 05900016 * BE ISSUED TO RELEASE A DEVICE WHEN APPROPRIATE 05920016 .GEN13 ANOP 05930017 EJECT 05940016 * ENTRY POINTS 06000016 * IGC048 DEQUEUE 06060016 * ENTERED FROM THE SVC FLIH BY A LPSW INSTRUCTION. 06120016 * THE PSW MUST BE 06180016 * 1-DISABLED FOR ALL MASKABLE INTERRUPTS 06240016 * EXCEPT MACHINE CHECK 06300016 * 2-BE IN SUPERVISOR MODE 06360016 * 3-HAVE A PROTECT KEY=0 06420016 * REGISTER 1 POINTS TO THE FIRST ENTRY IN 06480016 * THE PARAMETER LIST 06540016 * REGISTER 14 TO THE RETURN POINT 06600016 SPACE 1 06660016 * IGC056-ENQUEUE 06720016 * ENTERED FROM THE SVC FLIH BY A LPSW INSTRUCTION. 06780016 * THE PSW MUST BE 06840016 * 1-DISABLED FOR ALL MASKABLE INTERRUPTS 06900016 * EXCEPT MACHINE CHECK 06960016 * 2-BE IN SUPERVISOR MODE 07020016 * 3-HAVE A PROTECT KEY=0 07080016 * REGISTER 1-POINTS TO THE FIRST ENTRY IN 07140016 * THE PARAMETER LIST 07200016 * REGISTER 14-TO THE RETURN POINT 07260016 SPACE 1 08940016 AIF (NOT &B(1)).GEN14 08970017 * IEA0EQ01-MANUAL PURGE ROUTINE 09000016 * ENTERED ON A BRANCH FROM EITHER END OF 09060016 * TASK OR ABEND TO REMOVE ALL QEL'S 09120016 * ASSOCIATED WITH THE TCB SPECIFIED 09180016 * IN REGISTER 4 09240016 .GEN14 ANOP 09270017 EJECT 09300016 * EXIT POINTS 09360016 * 1-TO THE CALLER VIA A BRANCH ON REGISTER 14 09420016 * 2-TO THE DISPATCHER WHEN THE CALLER CANNOT 09480016 * HAVE IMMEDIATE USE OF THE RESOURCES ON 09540016 * WHICH HE ENQUEUED. 09600016 * 3-TO A TASK OF HIGHER PRIORITY THEN THE 09660016 * CALLER IF THE CALLER FREE'S RESOURCES 09720016 * HERETOFORE HOLDING UP THE HIGHER PRIORITY TASK 09780016 SPACE 2 09840016 * ERROR EXIT POINTS 09900016 * TO ABEND WITH THE FOLLOWING ERROR CODES 09960016 * FROM DEQUEUE 10020016 * 130-A DEQUEUE WAS ISSUED FOR A RESOURCE 10080016 * ON WHICH THE CALLER HAD NOT 10140016 * PREVIOUSLY ENQUEUED. 10200016 * 230-INVALID MINOR NAME LENGTH 10260017 * 330-RMC ISSUED IN PROBLEM PROGRAM STATE 10320017 * 430-INVALID PARAMETER LIST 10380017 * 530-DEQ ISSUED FOR QEL NOT IN CONTROL 10440017 SPACE 1 10500016 * FROM ENQUEUE 10560016 * 138-AN ENQ WAS ISSUED FROM A TASK 10620016 * FOR A RESOURCE ON WHICH THAT 10680016 * TASK ALREADY HAS A REQUEST. 10740016 * 238-THE 'RNAME' LENGTH IS INVALID 10800016 * 338-A SET MUST COMPLETE WAS ISSUED 10860016 * BY A PROBLEM PROGRAM. I.E., THE 10920016 * SVC OLD PSW PROTECT KEY WAS NOT 10980016 * EQUAL TO ZERO 11040016 * 438-INVALID PARAMETER LIST 11070017 EJECT 11100016 * TABLES AND CONTROL BLOCKS REFERENCED 11160016 SPACE 2 11220016 * EXTERNAL/INTERNAL SYMBOLS 11280016 SPACE 1 11340016 EXTRN IEATCBP ADDRESS OF 'NEW' TCB 11400016 EXTRN IEA0DS ENTRY POINT TO DISPATCHER 11420016 AIF (NOT &B(1)).SHRD000 11440016 EXTRN IEA0DS02 ENTRY POINT TO TASK SWITCH 11580016 .SHRD000 ANOP 11610016 SPACE 3 11640016 ENTRY IGC056 ENTRY POINT TO ENQ 11700016 AIF (&B(1)).SHRD010 11708016 ENTRY IEA0SMC ENTRY POINT TO MUST COMPLETE 11724016 ENTRY ABENTRY ENTRY TO DEQ FOR ABEND IN MFT ATTH 19054 11732019 AGO .SHRD020 11740016 .SHRD010 ANOP 11748016 ENTRY IEA0EQ01 ENTRY POINT TO MANUAL PURGE 11760016 .SHRD020 ANOP 11910016 AIF (&B(1)).SHRD022 19772 11913019 ENTRY IEAGENA0 19772 11916019 ENTRY IEAGENA1 19772 11919019 AGO .SHRD021 19772 11922019 .SHRD022 ANOP 19772 11925019 ENTRY IEAQENA0 19772 11928019 ENTRY IEAQENA1 19772 11931019 .SHRD021 ANOP 19772 11934019 EJECT 11940016 * GENERAL REGISTER EQUATES 12000016 SPACE 1 12060016 GMREG EQU 0 FOR REGISTER GETMAIN 12120016 WORKREG0 EQU 0 GENERAL WORK REGISTER 12180016 REG1 EQU 1 WORK REG A34816 12180120 REG0 EQU 0 PARAMETER REGISTER 20021 12200020 FMREG EQU 1 FOR REGISTER FREEMAIN 12240016 INPUTREG EQU 1 POINTER TO INPUT LIST 12300016 SUMREG EQU 1 FOR REGMAIN CALCULATIONS 12360016 GMRETREG EQU 1 RETURN REGISTER FROM GETMAIN 12420016 ABENDREG EQU 1 WHEN ABENDING CURRENT REQUESTOR 12480016 MCTCBRG EQU 1 THE ADDR OF THE MC TASK 12540016 BASEREG EQU 2 BASE REGISTER 12600016 CHKBASE EQU 2 VALIDITY CHECK BASE 12630016 WORKREG3 EQU 3 GENERAL WORK REGISTER 12660016 UCBREG EQU 3 12680016 ZENREG EQU 3 12700016 CURTCB EQU 4 CURRENT TCB ADDRESS 12720016 CURRB EQU 5 CURRENT RB ADDRESS 12780016 WORKREG4 EQU 6 GENERAL WORK REGISTER 12840016 TOPPARM EQU 6 ADDRESS OF 1ST LIST ELEMENT 12900016 PURGEREG EQU 6 12930016 CURMIN EQU 7 CURRENT MINOR QCB ADDRESS 12960016 WORKREG7 EQU 7 REGISTER FOR VALIDITY CHECK RTN 12990017 CURMAJ EQU 8 CURRENT MAJOR QCB ADDRESS 13020016 TIOEREG EQU 8 13050016 CURQEL EQU 9 CURRENT QEL ADDRESS 13080016 BRCHECK EQU 9 LCS 13110017 TASKTCB EQU 10 TCB ADDR FOR TASK SWITCH 13140016 CURPARM EQU 10 CURRENT LIST ELEMENT 13200016 WORKREG1 EQU 11 GENERAL WORK REGISTER 13260016 WKRG1 EQU 11 GENERAL WORK REGISTER 13320016 TCBREG EQU 11 FOR RIPPLING DOWN TCB QUEUE 13380016 TIOUCBRG EQU 11 13410016 JSTCBRG EQU 12 ADDRESS OF JOB STEP TCB 13440016 WORKREG2 EQU 12 GENERAL WORK REGISTER 13500016 WKRG2 EQU 12 GENERAL WORK REGISTER 13560016 TIOTREG EQU 12 13570016 TIODVRG EQU 12 13580016 RELWK1 EQU 12 13590016 LINKREG EQU 13 INTERNAL LINK REGISTER 13620016 RETREG EQU 14 RETURN REGISTER 13680016 WKRG3 EQU 14 WORK REGISTER SDA2 13686017 WKRG4 EQU 15 WORK REGISTER SDA2 13692017 RE EQU 14 LCS 13700017 RF EQU 15 LCS 13720017 GENREG EQU 15 SELECTED USE 13740016 MASKREG EQU 15 DISPATCHABILITY MODIFIER 13800016 HILOPTR EQU 16 DISP VALUE TO PICK UP LCS PTR 4027 13830019 EJECT 13860016 * TCB EQUATES 13920016 SPACE 1 13980016 TCBPKF EQU 28 TCB PROTECT KEY FIELD 14040016 TCBFLG EQU 29 * 14100016 TCBFLG1 EQU 30 * TCB FLAGS 14160016 TCBFLG2 EQU 31 * 14220016 TCBDISP EQU 33 TCB DISPATCHABILITY FLAGS 14280016 TCBGRS0 EQU 48 OFFSET TO TCB REGISTER SAVE 14340016 TCBGRS EQU 48 OFFSET TO REGISTER SAVE AREA 14348016 AIF (&B(1)).SHRD030 14356016 TCBCT EQU 34 ENQ COUNT FIELD IN TCB 14364016 TCBDSP EQU 35 OFFSET FOR PRIORITY CODE 14372016 AIF (NOT &B(2)).NOSDASB 14373019 TCBPRGBT EQU X'99' BYTE CONTAINING DEQ PURGE FLAG I250 14374019 TCBDUMPG EQU X'01' TEST PURGE FROM DUMP DATASET I250 14375019 .NOSDASB ANOP 14376019 TCBBYBOX EQU 24 BOUNDARY BOX DISP. IN TCB I250 14377019 TCBJSTEP EQU 44 JOB STEP TCB DISP. IN TCB I250 14378019 AGO .SHRD040 14380016 .SHRD030 ANOP 14388016 TCBCT EQU 112 ENQ COUNT FIELD IN TCB 14400016 .SHRD040 ANOP 14430016 TCBTCB EQU 116 NEXT LOWER TCB ON READY QUEUE 14460016 JSPTR EQU 124 ADDR OF JOB STEP TCB IN TCB 14520016 TCBNTC EQU 128 ADDRESS OF SISTER TCB 14580016 TCBOTC EQU 132 ADDRESS OF MOTHER TCB 14640016 TCBLTC EQU 136 ADDRESS OF DAUGHTER TCB 14700016 AIF (NOT &B(3)).TSO0100 20021 14706020 TCBTSFLG EQU 148 TIME-SHARING STATUS FLAGS 20021 14712020 TCBJSCB EQU 180 ADDRS OF JOB STEP CTL-BLK 20021 14718020 SPACE 1 20021 14724020 TCBTSTSK EQU X'80' STATUS BIT INDICATING A 20021 14730020 * TIME-SHARING TASK. 20021 14736020 AGO .TSO0105 20021 14742020 .TSO0100 ANOP 20021 14748020 SPACE 1 14760016 .TSO0105 ANOP 20021 14790020 ABTERM EQU X'80' ABTERM BIT IN TCB 14820016 TCBFJMC EQU X'08' TO SET TCB MUST COMPLETE 14880016 TCBRJMC EQU X'F7' TO RESET STEP MUST COMPLETE 14940016 TCBFSMC EQU X'10' TO SET TCB SYS MUST COMPLETE 15000016 TCBRSMC EQU X'EF' TO RESET SYS MUST COMPLETE 15060016 TCBFXS EQU X'01' SET TO DEFER ASYNC EXITS 15120016 TCBFXR EQU X'FE' RESET ASYNC EXIT FLAG 15180016 PKEY0 EQU X'F0' PROTECT KEY PORTION OF TCBPKF 15240016 SPACE 3 15300016 * RB EQUATES 15360016 SPACE 1 15420016 RBPSW EQU 16 RESUME PSW IN RB 15450016 PSWADR EQU 16 RESUME PSW IN RB 15480016 RBLINK EQU 28 SVRB LINK FIELD 15510016 RBWCF EQU 28 WAIT COUNT FIELD IN RB 15540016 SVCOPSW EQU 33 SECOND BYTE OF SVC OLD PSW 15600016 XSAV EQU 96 EXTENDED SAVE AREA 15660016 RBSAVUCB EQU X'80' UCB SAVE FOR SHARED DASDI A30097 15661020 SEPLP EQU X'84' . SVRB DISP FOR PARM LIST PTR 3123 15663020 SEPLP1 EQU X'88' . SAVE AREA FOR REG 10 BJ A50045 15666021 AIF (&B(1)).MFTA40 15670019 RBNAME EQU 6 PTR TO LAST TWO BYTES OF NAME I250 15680019 TWO EQU 2 COMPARE LENGTH FOR ABEND SVRB I250 15690019 RG14INRB EQU 124 RET REG STORED IN ABEND SVRB I250 15700019 .MFTA40 ANOP 15710019 SPACE 3 15720016 * GENERALIZED EQUATES 15780016 SPACE 1 15840016 DCELBBNR EQU 0 BIN # IN SUB-UCB SDA2 15870017 D0 EQU 0 . DISP VALUE OF 0 BJ 44371 15877021 D3 EQU 3 . DISP VALUE OF 3 BJ 44371 15884021 D5 EQU 5 . DISP VALUE OF 5 BJ 44371 15891021 ONE EQU 1 VALUE OF ONE 15900016 UCBID EQU 2 ID IN UCB SDA2 15920017 UCBSIZE EQU 56 SIZE OF MAIN UCB SDA2 15940017 LPSW EQU 8 LENGTH OF PSW 15960016 PREVIOUS EQU 5 DISPLACEMENT TO PREVIOUS FIELD 16020016 LNEW EQU 4 LENGTH FOR COMPARE OF NEW AND OLD 16050016 SPACE 1 16080016 WAITIND EQU X'00' FOR TESTING 16140016 ANYON EQU X'FF' BYTE VALUES 16200016 SYSTEMS EQU X'08' 16203016 SYSKEY EQU X'FE' 16206016 RESERVE EQU X'48' 16209016 NORESRVE EQU X'BF' BJ M2508 16210021 RESERVED EQU X'40' 16212016 ONERESV EQU X'01' USE TO TEST FOR RELEASE 19772 16212520 UCBIDMSK EQU 255 MASK TO TEST FOR A UCB 4531 16212720 UCBNAME EQU 13 DISP FOR THE EBCDIC DEVICE NAME 4531 16212820 UCBNMEMK EQU 192 MASK TO TEST FOR UCB 4531 16212920 DB0 EQU 0 . STANDARD VALUE OF 0 A34816 16213020 DB4 EQU 4 . STANDARD VALUE OF 4 A34816 16217020 DB16 EQU 16 . STANDARD DISP. EQUATES A34816 16217420 DB20 EQU 20 . STANDARD DISP. EQUATE OF 20 A34816 16217820 AIF (&B(1)).MFTA50 16221620 CVTADDR EQU 16 ADDR OF CVT I250 16225720 MFTATTCH EQU X'08' TEST FOR MFT ATTACH IN CVT I250 16229820 .MFTA50 ANOP 16233920 SHARED EQU X'20' 16238020 QELUCB EQU 12 16242120 PTRUCB EQU 12 16246220 UCBRSCT EQU 40 16250320 RESINDIC EQU 41 UCB RESERVE INDICATOR 16254420 TIOELNGH EQU 24 16258520 TIODDLNG EQU 16 16262620 TIOEFSRT EQU 0 16266720 TIOTEND EQU 0 16270820 TCBTIOT EQU 12 16274920 DEVTYP EQU 18 16279020 DIRACCS EQU X'20' 16283120 AIF (&B(1)).SHRD045 16287220 CURPRG EQU 104 OFFSET TO XR8 IN TCB 16291320 AGO .SHRD046 16295420 .SHRD045 ANOP 16299520 CURPRG EQU 80 16303620 .SHRD046 ANOP 16307720 UCBSKA EQU 48 16311820 EJECT 16315920 * PARAMETER LIST ELEMENT 16320016 SPACE 3 16380016 ******************************************* 16440016 * 0 * 1 * 2 * 3 * 16500016 * LISTEND * LMINOR * PARMCDS * RETURN * 16560016 * * * * * 16620016 ******************************************* 16680016 * 4 * 16740016 * ADDRESS OF MAJOR RESOURCE NAME * 16800016 * * 16860016 ******************************************* 16920016 * 8 * 16980016 * ADDRESS OF MINOR RESOURCE NAME * 17040016 * * 17100016 ******************************************* 17160016 *12 POINTER TO THE UCB ADDRESS * 17162016 * FOR RELEASE REQUESTS * 17164016 * * 17166016 ******************************************* 20021 17168020 SPACE 2 17170016 * DEFINITION OF FLAGS AT OFFSET 2 17172016 * BIT 0 - IF SET TO ONE, INDICATES SHARED REQUEST 17174016 * - IF SET TO ZERO, INDICATES EXCLUSIVE REQUEST 17176016 * BIT 1 - SEE BELOW 17178016 * BIT 2 - IF SET TO ONE, INDICATES REQUEST FOR SYSTEM MUST COMPLETE 17180016 * BIT 3 - IF SET TO ONE, INDICATES REQUEST FOR STEP MUST COMPLETE 17182016 * BIT 4 - SEE BELOW 17184016 * BITS 5,6, AND 7 17186016 * 001 - RET=HAVE 17188016 * 010 - RET=CHNG 20021 17189020 * 011 - RET=USE 17190016 * 111 - RET=TEST 17192016 * BITS 1 AND 4 PERTAIN TOTHE SCOPE OF THE REQUEST AND HAVE THE FOLL 17194016 * OWING MEANING 17196016 * BIT 1 BIT 4 MEANING 17198016 * 0 0 STEP 17200016 * 0 1 RESERVE 17202016 * 1 0 SYSTEM 17204016 * 1 1 SYSTEMS 17206016 * ON A RESERVE REQUEST, THE SCOPE IS AUTOMATICALLY CONVERTED TO 17208016 * SYSTEMS.(KNOWN ACROSS SYSTEMS). 17210016 SPACE 3 17220016 * WHERE: 17280016 SPACE 1 17340016 LISTEND EQU 0 OFFSET TO LIST END INDICATOR 17400016 LMINOR EQU 1 OFFSET TO LENGTH OF MINOR NAME 17460016 PARMCDS EQU 2 OFFSET TO PARAMETER CODES 17520016 RETURN EQU 3 OFFSET TO RETURN CODE FIELD 17580016 PTRMAJ EQU 4 OFFSET TO ADDR OF MAJOR NAME 17640016 PTRMIN EQU 8 OFFSET TO ADDR OF MINOR NAME 17700016 SPACE 1 17760016 ENDIND EQU 128 END OF LIST INDICATOR @JK68363 17820021 PLMI EQU X'80' PLUS OR MINUS INDICATOR 17880016 SHARE EQU X'40' SHARED RESOURCE INDICATOR 17940016 SMC EQU X'30' SET MUST COMPLETE INDICATORS 18000016 SMCSYS EQU X'20' SYSTEM MUST COMPLETE 18060016 SMCSTP EQU X'10' STEP MUST COMPLETE 18120016 HAVE EQU X'01' TO TEST 'HAVE' MASK 18180016 CHNG EQU X'02' TO TEST CHNG MASK 20021 18210020 USE EQU X'03' TO TEST 'USE' MASK 18240016 TEST EQU X'07' TO TEST 'TEST' MASK 18300016 AVAIL EQU X'00' RETURN CODE OF ZERO 18360016 INUSE EQU X'04' RETURN CODE OF FOUR 18420016 HAS EQU X'08' RETURN CODE OF EIGHT 18480016 SPACE 1 18540016 PARMSIZE EQU 12 LENGTH OF ELEMENT 18600016 PLASTBYT EQU 11 PTR TO LAST BYTE @JK67730 18630021 LPARM EQU 12 LENGTH OF ELEMENT 18660016 RESVSIZE EQU 16 SIZE OF RESERVE PARAMETER LIST 18690016 EJECT 18720016 ***** CONTROL BLOCK FORMATS ***** 18780016 SPACE 3 18840016 * MAJOR QUEUE CONTROL BLOCK 18900016 SPACE 1 18960016 ******************************************* 19020016 * 0 * 19080016 * ADDRESS OF NEXT MAJOR QCB * 19140016 * * 19200016 ******************************************* 19260016 * 4 * 19320016 * ADDRESS OF PREVIOUS MAJOR QCB * 19380016 * * 19440016 ******************************************* 19500016 * 8 * 19560016 * ADDRESS OF FIRST MINOR QCB * 19620016 * * 19680016 ******************************************* 19740016 * 12 * 19800016 * MAJOR QCB NAME * 19860016 * * 19920016 ******************************************* 19980016 * 16 * 20040016 * MAJOR QCB NAME * 20100016 * * 20160016 ******************************************* 20220016 SPACE 2 20280016 NXMAJ EQU 0 POINTER TO NEXT MAJOR QCB 20340016 PREVMAJ EQU 4 POINTER TO PREVIOUS MAJOR QCB 20400016 FSTMIN EQU 8 POINTER TO FIRST MINOR QCB 20460016 LMAJ EQU 8 LENGTH OF MAJOR NAME 20520016 MAJNAME EQU 12 MAJOR QCB NAME 20580016 MAJSIZE EQU 24 SIZE OF MAJOR TO A DBL WORD 20640016 MAJCLR EQU 12 PORTION TO CLEAR IN MAJOR QCB 2926 20700018 EJECT 20760016 * MINOR QUEUE CONTROL BLOCK 20820016 SPACE 1 20880016 ******************************************* 20940016 AIF (NOT &B(3)).TSO0111 20021 20950020 * 0 * 1 * 20021 20960020 * MIN * ADDRESS OF FIRST QEL * 20021 20970020 * TJID1 * * 20021 20980020 ******************************************* 20021 20990020 * 4 * 5 * 20021 20991020 * MIN * ADDRESS OF PREVIOUS * 20021 20992020 * TJID2 * MINOR QCB * 20021 20993020 AGO .TSO0112 20021 20994020 .TSO0111 ANOP 20021 20995020 * 0 * 21000016 * ADDRESS OF FIRST QEL * 21060016 * * 21120016 ******************************************* 21180016 * 4 * 21240016 * ADDRESS OF PREVIOUS MINOR QCB * 21300016 * * 21360016 .TSO0112 ANOP 20021 21370020 ******************************************* 21420016 * 8 * 21480016 * ADDRESS OF NEXT MINOR QCB * 21540016 * * 21600016 ******************************************* 21660016 * 12 * 13 * 14 * 21720016 * LENGTH * QCBPKF * MINOR QCB NAME * 21780016 * * * * 21840016 ******************************************* 21900016 * 16 * 21960016 * MINOR QCB NAME * 22020016 * (VARIABLE LENGTH) * 22080016 ******************************************* 22140016 SPACE 3 22200016 FSTQEL EQU 0 ADDRESS OF FIRST QEL 22260016 PREVMIN EQU 4 ADDRESS OF PREVIOUS MINOR QCB 22320016 PREVMIN1 EQU PREVMIN+1 . ADDRESS OF PREVIOUS M/QCB M0852 22370020 NXMIN EQU 8 ADDRES OF NEXT MINOR QCB 22380016 ELEVEN EQU 11 DISPLACEMENT TO LENGTH -1 22440016 LMINAME EQU 12 LENGTH OF MINOR NAME 22500016 QCBPKF EQU 13 TCB PROTECT KEY FIELD IN QCB 22560016 MINAME EQU 14 MINOR NAME 22620016 SPACE 1 22680016 NOKEY EQU X'FF' INDICATES A SHARED RESOURCE 22740016 SPACE 1 22800016 MINCLR EQU 12 PORTION TO CLEAR IN MINOR QCB 2926 22860018 FULLSIZE EQU 21 ALLOW ROUNDING TO A DBL WORD 22920016 EJECT 22980016 * QUEUE ELEMENT * 23040016 SPACE 1 23100016 ******************************************* 23160016 * 0 * 1 * 23220016 * SMC * ADDRESS OF NEXT QEL * 23280016 * * * 23340016 ******************************************* 23400016 * 4 * 5 * 23460016 * CODE * ADDRESS OF PREVIOUS QEL * 23520016 * * * 23580016 ******************************************* 23640016 AIF (NOT &B(3)).TSO0120 20021 23645020 * 8 * * 20021 23650020 * TJID0 * ADDRESS OF ENQUEUEING TCB * 20021 23655020 * * * 20021 23660020 ******************************************* 20021 23665020 * 12 * * 20021 23670020 * TJID1 * ADDRESS OF SVRB FOR ENQ * 20021 23675020 * * * 20021 23680020 ******************************************* 20021 23685020 AGO .TSO0130 20021 23690020 .TSO0120 ANOP 20021 23695020 * 8 * 23700016 * ADDRESS OF ENQUEUEING TCB * 23760016 * * 23820016 ******************************************* 23880016 * 12 * 23940016 * ADDRESS OF SVRB FOR ENQ * 24000016 * * 24060016 ******************************************* 24120016 .TSO0130 ANOP 20021 24123020 SPACE 2 24127016 * IF THE QEL REPRESENTS A RESERVE REQUEST AND THE REQUESTOR WAS GIVEN 24134016 * CONTROL OF THE RESOURCE, OFFSET 12 WILL CONTAIN THE UCB ADDRESS 24141016 * OFFSET 4 FLAG DEFINITIONS 24148016 * X'00' - INDICATES EXCLUSIVE REQUEST 24155016 * X'40' - INDICATES RESERVE REQUEST 24162016 * X'80' - INDICATES SHARED REQUEST 24169016 SPACE 2 24180016 NXQEL EQU 0 POINTER TO NEXT QEL 24240016 QELSMC EQU 0 SMC INDICATOR IN QEL 24300016 PREVQEL EQU 4 POINTER TO PREVIOUS QEL 24360016 QELCDS EQU 4 QEL CODE BYTE 24420016 QELCLR EQU 4 PORTION TO BE CLEARED IN QEL 24480016 QELTCB EQU 8 POINTER TO TCB 24540016 AIF (NOT &B(3)).TSO0140 20021 24546020 QELTJID0 EQU 8 1ST HALF OF TIME-SHRNG 20021 24552020 * JOB IDENTIFICATION. 20021 24558020 *..............1ST BIT OF QELTJID0 IS A FLAG BIT THAT IS SET 20021 24564020 *..............ON FOR ALL QELS FOR A SWAPPED TIME-SHARING USER. 20021 24570020 QELTJID1 EQU 12 2ND HALF OF TIME-SHRNG 20021 24576020 * JOB IDENTIFICATION. 20021 24582020 .TSO0140 ANOP 20021 24588020 SVRBPTR EQU 12 POINTER TO SVRB OF ENQ 24600016 QELSIZE EQU 16 LENGTH OF QEL 24660016 NEGCODE EQU X'80' INDICATES MINUS QEL REQUEST 24720016 AIF (NOT &B(3)).TSO0145 20021 24730020 QELRBWT EQU X'20' INDICATES THAT SVRB 20021 24740020 * PROCESSNG IS TO BE 20021 24750020 * DELAYED UNTIL SWAPIN. 20021 24760020 .TSO0145 ANOP 20021 24770020 EJECT 24780016 AIF (&B(1)).NMFTA1 24790019 ABENTRY EQU * BR ENTRY POINT FOR MFT ATTACH I250 24800019 .NMFTA1 ANOP 24810019 BALR BASEREG,0 24840016 USING *,BASEREG 24900016 SPACE 3 24960016 *** HOUSEKEEPING AND INITIALIZATION 25020016 SPACE 1 25080016 AIF (&B(1)).SHRD050 25090016 AIF (NOT &B(2)).NOSDASA 25091019 CLC RBNAME(TWO,CURRB),ABSVRBNM BR ENTRY FROM ABEND I250 25092019 BNE REGDEQ NO, PROCESS AS REG DEQ I250 25093019 TM TCBPRGBT(PURGEREG),TCBDUMPG PURGE TCB FROM DUMP DS I250 25094019 BO REGDEQ YES,DO PURGE DEQ I250 25095019 * IF NOT MUST BE RELEASE OF SDASD REQUEST NOT DEQ I250 25096019 B RLSETEST DO RELEASE NO DEQ I250 25097019 REGDEQ EQU * I250 25098019 .NOSDASA ANOP 25099019 LA CURPARM,0(INPUTREG) INITIALIZE LOOP THROUTH PARAM LIST 25100016 LR TOPPARM,CURPARM SAVE POINTER TO FIRST ELEMENT 25110016 AGO .SHRD060 25120016 .SHRD050 ANOP 25130016 LR CURPARM,INPUTREG INITIALIZE LOOP THROUGH P.LIST 25140016 LR TOPPARM,INPUTREG SAVE POINTER TO FIRST ELEMENT 25200016 .SHRD060 ANOP 25230016 SPACE 3 25260016 *** INVOKE VALIDITY CHECK ROUTINE. 25320016 SPACE 1 25380016 BAL LINKREG,CHKLIST GO TO VALIDITY CHECK INTERFACE 25440016 SPACE 1 25500016 AIF (NOT &B(1)).SHRD070 25530016 *** VALIDITY CHECK NO GOOD, ABEND THE REQUESTOR. 25560016 BC 15,DRRX4 BAD RETURN, ABEND THE TASK 25620016 BC 15,DRRX3 BAD RETURN, ABEND THE TASK 25680016 BC 15,DRRX2 BAD RETURN, ABEND THE TASK 25740016 * RETURN TO NEXT INSTRUCTION IF LIST OK 25800016 SPACE 3 25860016 .SHRD070 ANOP 25890016 *** LINK TO 'FINDMAJ' IN AN ATTEMPT TO FIND A 25920016 * MAJOR QCB OF THE SAME NAME AS THAT PASSED 25980016 * IN THE SUBLIST. 26040016 SPACE 1 26100016 PARMLOOP BAL LINKREG,FINDMAJ LOCATE MAJOR QCB 26160016 LTR CURMAJ,CURMAJ Q.IS MAJOR QCB PRESENT 26220016 BC 4,DQERR1 NO, TEST FOR RETURN OR ABEND 26280016 SPACE 3 26340016 *** LINK TO 'FINDMIN' IN AN ATTEMPT TO FIND A 26400016 * MINOR QCB OF THE SAME NAME AS THAT PASSED 26460016 * IN THE SUBLIST. ONLY THE MINORS ON THE 26520016 * PREVIOUSLY FOUND MAJOR ARE SEARCHED. 26580016 SPACE 1 26640016 BAL LINKREG,FINDMIN LOCATE MINOR QCB 26700016 LTR CURMIN,CURMIN Q.IS MINOR QCB PRESENT 26760016 BC 4,DQERR1 NO, TEST FOR RETURN OR ABEND 26820016 EJECT 26880016 *** A MAJOR QCB AND MINOR QCB OF THE SAME NAMES 26940016 * AS THAT PASSED IN THE SUBLIST HAVE BEEN FOUND. 27000016 * WE NOW DETERMINE THAT A QEL FOR THIS TASK 27060016 * CAN BE LEGALLY DEQUEUED. 27120016 SPACE 1 27180016 * CONSIDERATION OF THE EXCLUSIVE (PLUS) AND 27240016 * SHARED (MINUS) ATTRIBUTES OF THE QEL IS GIVEN 27300016 * IN DETERMINING THE LEGALITY OF THE DEQUEUE. 27360016 SPACE 1 27420016 L CURQEL,FSTQEL(CURMIN) OBTAIN CURRENT QEL 27480016 CL CURTCB,QELTCB(CURQEL) Q.IS DEQ FROM SAME TASK 27540016 BC 8,TOPQEL YES, TAKE BRANCH 27600016 QELLIST TM 4(CURQEL),PLMI Q. IS CUR. QEL + OR - . 27660016 BC 8,DQERR2 PLUS, TEST FOR RETURN OR ABEND 27720016 GETNEXT L CURQEL,NXQEL(CURQEL) OBTAIN NEXT QEL 27780016 LA CURQEL,0(CURQEL) CLEAR HIGH ORDER BYTE 27840016 LTR CURQEL,CURQEL Q. IS NEXT QEL PRESENT 27900016 BC 8,DQERR1 NO, TEST FOR RETURN OR ABEND 27960016 QELNEXT CL CURTCB,QELTCB(CURQEL) Q. IS CUR TCB DEQ'UEUING 28020016 BC 7,QELLIST NO, TAKE BRANCH 28080016 TM 4(CURQEL),PLMI Q. IS CR. QEL + OR - . 28140016 BC 8,DQERR2A . PLUS, TEST FOR RETURN OR ABEND 5173 28200020 SPACE 3 28260016 *** A QEL HAS BEEN FOUND THAT CAN BE LEGALLY 28320016 * DEQUEUED. IT IS EITHER A EXCLUSIVE 28380016 * REQUEST ON THE TOP OF THE QUEUE, OR 28440016 * A SHARED REQUEST WITH NO EXCLUSIVE REQUESTS 28500016 * ABOVE IT. 28560016 SPACE 1 28620016 AIF (NOT &B(2)).SHRDA24 28626016 TOPQEL TM QELCDS(CURQEL),RESERVED Q. IS THIS QEL RESERVE QEL 28632016 BC 8,TOPQEL2 NO - SKIP RELEASE TEST 28638016 L UCBREG,QELUCB(CURQEL) YES - TEST FOR RELEASE 28650016 BAL LINKREG,RLSETEST RELEASE IF COUNT IS ZERO 28656016 TOPQEL2 TM PARMCDS(TOPPARM),HAVE Q. ARE RETURN CODES REQUESTED 28662016 AGO .SHRDA25 28668016 .SHRDA24 ANOP 28674016 TOPQEL TM PARMCDS(TOPPARM),HAVE Q. ARE RETURN CODES REQUESTED 28680016 .SHRDA25 ANOP 28710016 BC 8,NORET NO, SKIP RETURNS 28740016 MVI RETURN(CURPARM),AVAIL GIVE RETURN CODE OF ZERO 28800016 NORET BAL LINKREG,DECTCB DECREMENT TCBCT FIELD 28860016 LR WORKREG1,CURQEL LOAD CUR QEL ADDRESS 28920016 LR WORKREG2,CURQEL ASSUME PLUS REQUEST 28980016 TM 4(CURQEL),PLMI Q. IS QEL + OR - 29040016 BC 8,REMOVE +, TAKE BRANCH 29100016 LCR WORKREG2,CURQEL COMPLEMENT, INDICATING SHARED 29160016 SPACE 3 29220016 * LINK TO 'DQELEMNT' WHICH WILL DEQUEUE THE QEL 29280016 SPACE 1 29340016 REMOVE BAL LINKREG,DQELEMNT DEQUEUE THE QEL 29400016 EJECT 29460016 *** SET SIZE OF THE QEL AND LINK TO THE FREEMAIN ROUTINE. 29520016 SPACE 1 29580016 LA WORKREG0,QELSIZE OBTAIN QEL SIZE 29640016 LR FMREG,CURQEL LOAD ADR. OF QEL FOR FREEMAIN 29700016 BAL LINKREG,FREEUP BRANCH TO FREEMAIN INTERFACE 29760016 SPACE 3 29820016 *** QEL HAS BEEN REMOVED AND THE SPACE FREED. IF ANOTHER 29880016 * QEL IS NOT ON THE QUEUE GO TO PROCESS THE MINOR 29940016 * QCB. IF ANOTHER QEL HAS POPPED UP DETERMINE IF 30000016 * ITS SVRB WAIT COUNT SHOULD BE DECREMENTED 30060016 * AND THE TASK SWITCH ROUTINE INVOKED. 30120016 SPACE 1 30180016 L LINKREG,FSTQEL(CURMIN) . SET ADDR OF NEXT QEL M0852 30240020 LA LINKREG,0(,LINKREG) . CLEAR HI-ORDER BYTE M0852 30290020 CR WORKREG0,LINKREG . Q HAS A QEL POPPED TO TOP M0852 30292020 BC 8,PROCMIN NO, PROCESS MINOR 30300016 L CURQEL,FSTQEL(CURMIN) GET NEW TOP QEL 30360016 AIF (NOT &B(3)).TSO0500 20021 30362020 SPACE 2 20021 30364020 *** 20021 30366020 * THIS CODE TESTS TO SEE IF THE NEW TOP QEL BELONGS TO A 20021 30368020 * SWAPPED TIME-SHARING USER. IF SO, THE TIME-SHARING 20021 30370020 * DRIVER IS NOTIFIED TO SWAP THIS USER IN. SVRB PROCESSING 20021 30372020 * IS DELAYED UNTIL THE TIME-SHARING USER IS SWAPPED IN. 20021 30374020 TM QELTJID0(CURQEL),ANYON QEL FOR TIME-SHRNG TASK? 20021 30376020 BZ NOTTSQEL NO. CONTINUE. 20021 30378020 TM QELCDS(CURQEL),PLMI Q. IS QEL SHARED. 20021 30380020 BZ ROLLIN NO. ROLLIN USER. 20021 30382020 LTR WORKREG2,WORKREG2 WAS REMOVED QEL SHARED? 20021 30384020 BM NXTINPUT YES. CHK NXT PARAM LIST. 20021 30386020 ROLLIN OI QELCDS(CURQEL),QELRBWT FLAG QEL FOR SVRB PRO- 20021 30388020 * CESSING AFTER ROLLIN. 20021 30390020 LH REG0,QELTJID0(CURQEL) OBTAIN TIME-SHRNG USER'S 20021 30392020 IC REG0,QELTJID1(CURQEL) TERMINAL JOB ID. 20021 30394020 N REG0,TSDRVMSK CLEAR HIGH-ORDER BITS. 20021 30396020 SR REG1,REG1 20021 30398020 TSEVENT USERRDY,TJID=(0) 20021 30400020 TM QELCDS(CURQEL),PLMI Q. IS QEL SHARED. 20021 30402020 BZ NXTINPUT NO. CHK NXT PARAM LIST. 20021 30404020 B NEXTQEL 20021 30406020 * 20021 30408020 *** 20021 30410020 NOTTSQEL EQU * 20021 30412020 SPACE 2 20021 30414020 .TSO0500 ANOP 20021 30416020 TM QELCDS(CURQEL),PLMI Q. IS QEL SHARED 30420016 BC 8,PLUSQEL EXCLUSIVE, TAKE BRANCH 30480016 LTR WORKREG2,WORKREG2 Q. WAS REMOVED QEL SHARED 30540016 BC 4,NXTINPUT YES, TAKE BRANCH 30600016 REPQEL BAL LINKREG,DECSVRB DECREMENT SVRB/ TASK SWITCH 30660016 AIF (NOT &B(3)).TSO0505 20021 30670020 NEXTQEL EQU * 20021 30680020 .TSO0505 ANOP 20021 30690020 L CURQEL,NXQEL(CURQEL) OBTAIN NEXT QEL 30720016 LTR CURQEL,CURQEL Q. IS THERE A NEXT QEL 30780016 BC 8,NXTINPUT NO, TAKE BRANCH 30840016 AIF (NOT &B(3)).TSO0510 20021 30843020 SPACE 2 20021 30846020 *** 20021 30849020 * THIS CODE TESTS TO SEE IF THE NEXT QEL BELONGS TO A 20021 30852020 * SWAPPED TIME-SHARING USER. 20021 30855020 TM QELTJID0(CURQEL),ANYON QEL FOR A SWAPPED 20021 30858020 * TIME-SHARING TASK? 20021 30861020 BZ NOTTSQL NO. CONTINUE NORMALLY. 20021 30864020 TM QELCDS(CURQEL),PLMI Q. IS QEL SHARED. 20021 30867020 BZ NXTINPUT NO. CHK NXT PARAM LIST. 20021 30870020 B ROLLIN YES. TELL TIME-SHARING 20021 30873020 * DRIVER TO SWAPIN USER. 20021 30876020 * 20021 30879020 ******** 20021 30882020 NOTTSQL EQU * 20021 30885020 SPACE 2 20021 30888020 .TSO0510 ANOP 20021 30891020 TM QELCDS(CURQEL),PLMI Q. IS NEXT QEL SHARED 30900016 BC 1,REPQEL YES, TAKE BRANCH 30960016 BC 15,NXTINPUT TAKE BRANCH 31020016 PLUSQEL BAL LINKREG,DECSVRB DECREMENT SVRB/ TASK SWITCH 31080016 BC 15,NXTINPUT TAKE BRANCH 31140016 EJECT 31200016 *** A QEL HAS BEEN REMOVED AND ITS SPACE FREED. 31260016 * IT WAS THE ONLY QEL ON THE MINOR. THEREFORE, 31320016 * WE WANT TO REMOVE THE MINOR AND FREE THE SPACE. 31380016 * THE MAJOR WILL ALSO BE REMOVED AND ITS SPACE FREED 31440016 * IF THE MINOR WAS THE ONLY ONE ON THE CHAIN. 31500016 SPACE 1 31560016 PROCMIN BAL LINKREG,ADDMINOR SPACE 1 31620016 BAL LINKREG,DQMINOR DE-QUEUE MINOR QCB 31680016 LR WORKREG0,SUMREG LOAD MINOR SIZE 31740016 LR FMREG,CURMIN LOAD ADR. OF MINOR FOR FREEMAIN 31800016 BAL LINKREG,FREEUP BRANCH TO FREEMAIN INTERFACE 31860016 CL WORKREG0,FSTMIN(CURMAJ) Q. IS THERE ANY MORE MINORS 31920016 BC 7,NXTINPUT YES, TAKE BRANCH 31980016 LR WORKREG1,CURMAJ LOAD CURRENT MAJOR 32040016 BAL LINKREG,DQELEMNT DE-QUEUE MAJOR QCB 32100016 LA WORKREG0,MAJSIZE OBTAIN MAJOR SIZE 32160016 LR FMREG,CURMAJ LOAD ADR. OF MAJOR FOR FMAIN 32220016 BAL LINKREG,FREEUP BRANCH TO FREEMAIN INTERFACE 32280016 SPACE 3 32340016 *** DETERMINE IF THE SUBLIST PROCESSING IS COMPLETE. 32400016 * IF NOT, GET THE NEXT AND GO BACK TO THE TOP. 32460016 * IF YES, THE RESET MUST COMPLETE INTERFACE 32520016 * IS ENTERED AND THE ROUTINE INVOKED IF REQUESTED. 32580016 * WHEN COMPLETE RETURN VIA THE RETURN INTERFACE 32640016 * TO SET REGISTER FIFTEEN PROPERLY. 32700016 SPACE 1 32760016 NXTINPUT TM 0(CURPARM),ENDIND Q. IS THIS LAST INPUT ENTRY 32820016 LA CURPARM,LPARM(CURPARM) GET NEXT INPUT ENTRY 32880016 BZ PARMLOOP NO TAKE BRANCH @JK68363 32940021 BAL LINKREG,RMCOMP GO RESET MUST COMPLETE 33000016 RMCRET LR CURPARM,TOPPARM RESET FOR EXIT 33060016 AIF (&B(1)).SHRD080 33064016 BAL LINKREG,MCRET2 33068016 CLC RBNAME(TWO,CURRB),ABSVRBNM BR ENTRY FROM ABEND I250 33068619 BNE CONTIII CONTINUE NORMALLY 19054 33069219 L RETREG,RG14INRB(CURRB) RETURN REGISTER I250 33069819 BR RETREG YES - RETURN TO ABEND 19054 33070419 CONTIII EQU * 19054 33071019 L WORKREG1,NEW DOES CURRENT TASK REGAIN CONTROL 33072016 CLC 0(LNEW,WORKREG1),4(WORKREG1) 33076016 BC 8,GOEXIT YES. EXIT 33080016 MVC PSWADR(LPSW,CURRB),EXITPSW NO, SET UP PSW TO 33084016 * ISSUE SVC EXIT 33088016 STM 10,9,TCBGRS(CURTCB) SAVE REGS 33092016 L WORKREG2,DISPATCH AND GO TO THE DISPATCHER 33096016 BCR 15,WORKREG2 33100016 AGO .SHRD090 33104016 .SHRD080 ANOP 33108016 BC 15,MCRET2 GO TO EXIT INTERFACE 33120016 .SHRD090 ANOP 33150016 EJECT 33180016 SPACE 1 33240016 *** GET THE WAIT COUNT FIELD FROM THE SVRB. 33300016 * IF EQUAL TO ZERO, GET THE NEXT PARAMETER LIST ELEMENT. 33360016 * IF NOT EQUAL TO ZERO, DECREMENT THE WAIT COUNT BY ONE 33420016 SPACE 1 33480016 DECSVRB SR WORKREG2,WORKREG2 SET TO ZERO 33540016 L GENREG,SVRBPTR(CURQEL) OBTAIN SVRB POINTER 33600016 * A WAIT COUNT OF ZERO INDICATES THE TASK REPRESENTED BY 33660016 * THIS SVRB IS BEING ABENDED. IN THIS CASE DO NOT 33720016 * DECREMENT THE WAIT COUNT. 33780016 CLI RBWCF(GENREG),WAITIND Q. IS WAIT COUNT ZERO 33840016 BCR 8,LINKREG YES, RETURN TO MAINLINE 33900016 IC WORKREG2,RBWCF(GENREG) GET WAIT COUNT 33960016 BCTR WORKREG2,0 DECREMENT IT 34020016 STC WORKREG2,RBWCF(GENREG) AND PUT IT BACK 34080016 AIF (NOT &B(2)).SHRDA45 34084016 TM QELCDS(CURQEL),RESERVED 34088016 BC 8,NOTRSV 34092016 L WORKREG2,QELUCB(CURQEL) GET UCB PTR FROM QEL BJ 60112 34096021 L WORKREG2,RBSAVUCB(WORKREG2) GET PARM PTR FOR THIS QEL 34100021 ST WORKREG2,QELUCB(CURQEL) SET UCB POINTER IN QEL 34107016 SR WORKREG1,WORKREG1 CLEAR REG FOR IC 34108016 IC WORKREG1,UCBRSCT(WORKREG2) GET UCB RESERVE COUNT 34112016 LA WORKREG1,1(WORKREG1) 34116016 STC WORKREG1,UCBRSCT(WORKREG2) REPLACE NEW COUNT 34120016 NOTRSV CLI RBWCF(GENREG),WAITIND Q. IS SVRB STILL WAITING 34124016 AGO .SHRDA46 34128016 .SHRDA45 ANOP 34132016 CLI RBWCF(GENREG),WAITIND Q. IS SVRB STILL WAITING 34140016 .SHRDA46 ANOP 34170016 BCR 7,LINKREG YES, RETURN TO MAINLINE 34200016 EJECT 34260016 SPACE 2 34320016 *** IF WE FALL THROUGH TO THIS CODE THE TASK WHOSE WAIT COUNT 34380016 * WAS DECREMENTED CAN NOW HAVE CONTROL OF THE RESOURCES 34440016 * ON WHICH HE ENQUEUED. 34500016 AIF (&B(1)).SHRD100 34502016 * BUT WE MUST DETERMINE IF A HIGHER PRIORITY TASK IS TO BE 34504016 * DISPATCHED. IF SO, THE HIGHER PRIORITY TCB ADDRESS IN 'NEW' 34506016 * IS LEFT UNDISTURBED. OTHERWISE, THEENQUEUEING TASK'S TCB 34508016 * ADDRESS IS PLACED IN 'NEW'. 34510016 TASKSWTH L WORKREG1,QELTCB(CURQEL) GET TCB ADDRESS 34512016 TM TCBDISP(WORKREG1),X'FF' IS TASK DISPATCHABLE 34514016 BCR 7,LINKREG NO 34516016 TASKSWT2 L WORKREG3,0(WORKREG1) YES 34518016 TM RBWCF(WORKREG3),X'FF' IS RB IN WAIT 34520016 BCR 7,LINKREG YES 34522016 L WORKREG3,NEW NO. UPDATE 'NEW' ACCORDING 34524016 L WORKREG3,0(WORKREG3) TO PRIORITY 34526016 CLC TCBDSP(ONE,WORKREG3),TCBDSP(WORKREG1) COMPARE PRIOR BJ 34527021 BH D0(LINKREG) BRANCH HI BJ 40409 34528021 BE TSTSCH BRANCH EQ BJ 40409 34529021 CHNGNEW EQU * BJ 40409 34530021 L WORKREG3,NEW 34532016 ST WORKREG1,0(WORKREG3) 34534016 L CURTCB,LNEW(WORKREG3) RESORE THE CURRENT TCB PTR BJ40409 34535021 BCR 15,LINKREG 34536016 TSTSCH EQU * BJ 40409 34536121 L CURTCB,TCBTCB(WORKREG1) SEARCH CHAIN BJ 40409 34536221 TSTZRO LTR CURTCB,CURTCB BEGINNING WITH BJ 40409 34536321 BNZ COMPTCB TCB FROM NEW TOP QEL BJ 40409 34536421 L WORKREG3,NEW RETURN TO MAINLINE BJ 40409 34536521 L CURTCB,LNEW(WORKREG3) 34536621 BR LINKREG BJ 40409 34536721 COMPTCB EQU * BJ 40409 34536821 CR CURTCB,WORKREG3 IF EQUAL, NEW TCB IS BJ 40409 34536921 BE CHNGNEW HIGHER SCHED. PRIORITY BJ 40409 34537021 L CURTCB,TCBTCB(CURTCB) GET NEXT TCB BJ 40409 34537121 B TSTZRO CONTINUE SEARCH BJ 40409 34537221 AGO .SHRD110 34538016 .SHRD100 ANOP 34540016 * THE TASK SWITCH ROUTINE IS INVOKED, AND IF THE READY 34560016 * TASK IS OF HIGHER PRIORITY THAN THE CURRENT TASK, 34620016 * 'NEW' WILL BE MODIFIED TO REFLECT THE TASK SWITCH. 34680016 * NOTE THAT THE TASK WHOSE DEQUEUE REQUEST WE 34740016 * ARE NOW HANDLING MAY OR MAY NOT GET CONTROL NEXT. 34800016 SPACE 1 34860016 * PREPARATION FOR TASK SWITCH ROUTINE 34920016 * 1.REGISTER 10 MUST CONTAIN THE ADDRESS OF THE READY TCB 34980016 * 2.REGISTER 11 CONTAINS THE ADDRESS OF THE TASK SWITCH ROUTINE 35040016 * 3.REGISTER 14 IS THE RETURN REGISTER 35100016 SPACE 2 35160016 TASKSWTH LR WORKREG2,CURPARM SAVE POINTER TO PARAMETER LIST 35220016 L TASKTCB,QELTCB(CURQEL) GET TCB ADDRESS 35280016 TASKSW1 L WORKREG1,TASKSWT GET EP OF TASK SWITCH ROUTINE 35340016 LR GENREG,RETREG SAVE RETURN REGISTER 35400016 BALR RETREG,WORKREG1 GO TO TASK SWITCH ROUTINE 35460016 SPACE 2 35520016 * UPON RETURNING FROM THE TASK SWITCH ROUTINE. 35580016 LR CURPARM,WORKREG2 RESTORE PARAMETER LIST PTR 35640016 LR RETREG,GENREG RESTORE RETURN REGISTER 35700016 BCR 15,LINKREG RETURN TO MAINLINE 35760016 .SHRD110 AIF (NOT &B(2)).SHRDA43 35760516 SPACE 3 35761016 RLSETEST SR WORKREG1,WORKREG1 CLEAR FOR UCB COUNT 19772 35761319 IC WORKREG1,UCBRSCT(ZENREG) GET UCB RESERVE COUNT 19772 35761619 CLI UCBRSCT(ZENREG),ONERESV IS THIS LAST QEL RESVING 19772 35761919 BE RELEASE YES GO TO RELEASE DEVICE 19772 35762221 LTR WORKREG1,WORKREG1 IS RESERVE CNT ZERO 35762321 BNZ NOTRES NO CONTINUE 35762421 LA WORKREG1,1 PREVENT POSSIBLE DECRMT PAST ZERO 35762521 B RELEASE CHECK POSSIBLE RELEASE 19772 35762621 NOTRES BCTR WORKREG1,0 DECRMT UCB RES CNT AND 35762721 STC WORKREG1,UCBRSCT(ZENREG) STORE IT BACK 19772 35762819 BR LINKREG RETURN TO MAINLINE 19772 35763419 RELEASE CLI RESINDIC(ZENREG),WAITIND IS DEVICE RESERVED 19772 35763719 BC 8,NOTRES NO, BYPASS RELEASE 19772 35764019 * YES, DO RELEASE 19772 35764319 * NOTE: ANY CHANGE TO THE FOLLOWING RELEASE EXCP ROUTINE OR ITS 35765016 * ASSOCIATED INTERFACE WILL REQUIRE THE SAME CHANGE IN MFT-II 35765216 * MANUAL PURGE WHICH RESIDES IN MODULE, IEFSD597 35765416 EJECT 35766016 * FUNCTION * 35766516 * * 35767016 * 1. GET 100 BYTES FROM SUBPOOL 0 * 35767516 * * 35768016 * 2. INITIALIZE A DEB, DCB, IOB, ECB, AND CHANNEL PROGRAM * 35768516 * IN SUBPOOL 0 * 35769016 * * 35769516 * 3. ISSUE AN SVC 0 TO CAUSE A DEVICE RELEASE * 35770016 * * 35770516 * 4. WAIT FOR THE RELEASE TO COMPLETE * 35771016 * * 35771516 * 5. FREE CORE FROM SUBPOOL 0 * 35772016 * * 35772516 * 6. RETURN TO THE DEQUEUE ROUTINE * 35773016 * * 35773516 * ENTRY * 35774016 * * 35774516 * FROM DEQUEUE VIA A BRANCH * 35775016 * * 35775516 * EXIT * 35776016 * BACK TO DEQUEUE * 35776516 * * 35777016 * INPUT * 35777516 * * 35778016 * PTR TO CURRENT TCB IN REG TCBREG * 35778516 * PTR TO UCB OF DEVICE REQUIRING A RELEASE IN REG UCBREG * 35779016 * OUTPUT * 35779516 * NONE * 35780016 * * 35780516 * OPERATION * 35781016 * * 35781516 * SEE COMMENTS AND REMARKS ASSOCIATED WITH CODE * 35782016 * * 35782521 ********************************************************************** 35782621 * * 35782721 SPACE 3 35782821 * OBTAIN CORE REQUIRED FOR THE DCB, ECB, IOB, CCW AND DEB 35782921 SPACE 1 35783021 LR WORKREG2,GENREG PRESERVE REG 15 19772 35783121 XR CURRB,CURRB CLEAR SP REG @JK69690 35783221 TM TCBFLG,ABTERM IS TASK ABENDING @JK69690 35783321 BZ NOTABING NO @JK69690 35783421 GETMAIN EC,A=RLWKADD,LV=100 @JK69690 35783521 L GMRETREG,RLWKADD GET ADDR OF GOTTEN CORE @JK69690 35783621 LTR GENREG,GENREG WAS REQUEST SATISFIED @JK69690 35783721 BZ GOON YES @JK69690 35783821 LA CURRB,253 NO-PREPARE FOR SQS REQUEST @JK69690 35783921 NOTABING GETMAIN R,SP=(CURRB),LV=100 @JK69690 35784021 SLL CURRB,24 SHIFT SPID TO HO BYTE @JK69690 35784121 OR FMREG,CURRB SAVE SPID FOR FREEING @JK69690 35784221 GOON EQU * @JK69690 35784321 LR GENREG,WORKREG2 RESTORE WORKREG3 19772 35785819 BCTR WORKREG1,0 DECR UCB COUNT AND 19772 35785919 STC WORKREG1,UCBRSCT(ZENREG) STORE IT 19772 35786019 LR WORKREG1,GMRETREG GET ADDRESS OF GOTTEN CORE 19772 35786219 USING RLDCB,WORKREG1 USE AS BASE FOR DSECT 35786516 * INITIALIZE DEB 35787016 XC 0(100,WORKREG1),0(WORKREG1) CLEAR GOTTEN CORE 35787516 MVI DENEXT,X'02' NUMBER OF EXTENTS 35789516 ST WORKREG1,DEDCBAD POINT DEB TO DCB 35791016 MVI DEPKID,X'0F' SET DEB ID 35791516 MVZ DEPKID,TCBPKF(TCBREG) SET DEB PROTECT KEY 35792016 L RELWK1,CVTPTR GET ADDR OF CVT 35792316 L RELWK1,CVTXAPG-CVT(RELWK1) GET ADDR OF IOS APP TABLE 35792616 ST RELWK1,DEAPPAD STORE IN TBL POINTER SLOT 35793016 MVI DEEXTSCL,X'04' SET SIZE OF EXTENTS 35793516 ST UCBREG,DEUCBAD-2 SET POINTER TO UCB 35794016 MVI DEFM,X'18' SET FILE MASK 35794516 MVC DEBB(2),UCBSKA+1(UCBREG) SET BIN NUMBER OF DEVICE 35795016 MVI DEEND,X'FF' INIT END C TO 'FF' 35796016 MVC DEEND+1(3),DEEND PROPAGATE 'FF' TO REMAINING CHH 35796516 LA RELWK1,X'01' SET NO. ALLOCATED TRACKS TO 1 35797016 STH RELWK1,DETRKS STORE IN DEB 35797516 * INITIALIZE IOB 35798016 MVI IOBFL1,X'02' SET IOB FLAGS 35798516 MVI IOBFL2,X'00' 35799016 ST WORKREG1,IOBECBAD SET ADDRESS OF ECB 35799516 LA RELWK1,RLCCW GET ADDRESS OF CHANNEL PROGRAM 35800016 ST RELWK1,IOBSTART POINT IOB TO CHANNEL PROGRAM 35800516 ST WORKREG1,IOBDCBAD POINT IOB TODCB 35801016 MVC IOBSK(4),UCBSKA+1(UCBREG) MOVE IN SEEK ADDRESS FOR UCB 35802021 * THIS STMT DELETED THEN REINSERTED @SA63281 35802221 * INITIALIZE DCB 35802516 LA RELWK1,DEAPGV GET ADDRESS OF DEB 35803016 ST RELWK1,DCBDEBAD POINT DCB TO DEB 35803516 * INITIALIZE CHANNEL PROGRAM 35804016 MVI RLCCW,X'03' NOP COMMAND CODE 35804516 MVI RLCCW+4,X'20' SUPPRESS INCORRECT LENGTH IND. 35805016 MVI RLCCW+7,X'EE' IDENTIFICATION, NORMALLY COUNT 35805516 LR WORKREG2,GENREG PRESERVE WORKREG3 35805716 EXCP RLIOB ISSUE RELEASE 35806516 * 35807016 WAIT ECB=RLECB WAIT FOR RELEASE 35807516 SSM *+1 DISABLE 35807816 LR GMRETREG,WORKREG1 SET UP ADDR FOR FREEMAIN 35808121 SLDL GMREG,8 GET SPID IN REG0 @JK69690 35808221 SRL FMREG,8 SHIFT ADDR OF CORE BACK @JK69690 35808321 LR GENREG,REG0 SPID TO WORKREG @JK69690 35808421 SLL GENREG,24 SPID IN HO BYTE @JK69690 35808521 LA REG0,100 LENGTH OF ACQUIRED CORE @JK69690 35808621 OR REG0,GENREG ADDR & SPID TOGETHR FOR FM @JK69690 35808721 FREEMAIN R,LV=(0),A=(1) @JK69690 35808828 * 35808921 L CURRB,D0(CURTCB) RESTORE SVRB POINTER @JK69690 35809021 LR GENREG,WORKREG2 RESTORE WORKREG3 35809216 BCR 15,LINKREG RETURN TO CALLER 35809516 .SHRDA43 ANOP 35810016 EJECT 35820016 *** DETERMINE IF A RESET MUST COMPLETE OPERATION HAS BEEN 35880016 * REQUESTED. 35940016 * IF YES, INTERFACE INTERNALLY WITH THE SMC/RMC ROUTINE. 36000016 * IF NO, RETURN. 36060016 SPACE 1 36120016 RMCOMP TM PARMCDS(TOPPARM),SMC Q. RMC REQUESTED 36180016 BCR 8,LINKREG NO, RETURN 36240016 LR WORKREG3,RETREG YES, SAVE LINKREG 36300016 TM PARMCDS(TOPPARM),SMCSYS Q. IS SYSTEM RESET REQUESTED 36360016 BC 8,STEPRMC NO, BRANCH TO STEP PROCESS 36420016 AIF (&B(1)).SHRD120 36450016 LCR INPUTREG,CURTCB COMPLIMENT TCB FOR SYSTEM 36480016 LH WORKREG0,RMCSYSMK LOAD SYSTEM MASK 36540016 NI TCBFLG1(CURTCB),TCBRSMC RESET MUST COMPLETE 36600016 MCSTPSYS EQU * 19054 36604019 BAL RETREG,SETRSMC GO TO SMC ROUTINE 36608016 LR RETREG,WORKREG3 36612016 L WORKREG3,ADSYMCSW 36616016 OI 1(WORKREG3),X'F0' RESET SWITCH FOR EXITING FROM SIRB 36620016 BC 15,ALLOWAX 36624016 STEPRMC NI TCBFLG1(CURTCB),TCBRJMC TURN OFF SMC FLAG 36628016 LH WORKREG0,RMCSTPMK LOAD STEP MASK 19054 36629019 LR INPUTREG,CURTCB 19054 36630019 B MCSTPSYS 19054 36631019 ALLOWAX NI TCBFLG(CURTCB),TCBFXR ALLOW ASYNCHRONOUS EXITS 36632016 BCR 15,LINKREG RETURN TO MAINLINE 36636016 EJECT 36640016 AGO .SHRD130 36644016 .SHRD120 ANOP 36648016 STATUS RESET,MC,SYSTEM RESET SYSTEM MUST COMPLETE 36738016 BC 15,DORMC BRANCH TO BRANCH 36828016 STEPRMC STATUS RESET,MC,STEP RESET STEP MUST COMPLETE 36918016 DORMC EQU * 20021 36927020 AIF (NOT &B(3)).TSO0600 20021 36936020 SPACE 2 20021 36945020 *** 20021 36954020 * TEST TO SEE IF THE RESET MUST COMPLETE WAS DONE FOR A 20021 36963020 * TIME-SHARING TASK. IF SO, NOTIFY THE TIME-SHARING DRIVER. 20021 36972020 TM PARMCDS(TOPPARM),SMCSYS REQUEST FOR SYSTEM MC? 20021 36981020 BZ NOTTSRMC NO. CONTINUE. 20021 36990020 TM TCBTSFLG(CURTCB),TCBTSTSK IS THIS A TIME- 20021 36999020 * SHARING TASK? 20021 37008020 BZ NOTTSRMC NO. CONTINUE. 20021 37017020 L REG1,TCBJSCB(CURTCB) ACCESS JOB STEP CTL BLK 20021 37026020 USING IEZJSCB,REG1 20021 37035020 LH REG0,JSCBTJID OBTAIN TERMINAL JOB ID. 20021 37044020 DROP REG1 20021 37053020 SR REG1,REG1 20021 37062020 TSEVENT RELMC,TJID=(0) 20021 37071020 * 20021 37080020 *** 20021 37089020 NOTTSRMC EQU * 20021 37098020 SPACE 2 20021 37107020 .TSO0600 ANOP 20021 37116020 B RMCRET RETURN TO MAINLINE 20021 37125020 EJECT 37140016 IEA0EQ01 BALR BASEREG,0 ESTABLISH BASE 37200016 LA GENREG,IEA0EQ01-IGC048 GET DIFFERENCE 37260016 SR BASEREG,GENREG RESET BASE 37320016 SPACE 1 37380016 SR WORKREG0,WORKREG0 INITIALIZE COMPERAND 37440016 L WORKREG3,ENTNQDQ REFR 37460018 USING NQDQQCB,WORKREG3 REFR 37480018 LA CURMAJ,HEADQCB GET ADDRESS OF HEAD 37500016 DROP WORKREG3 REFR 37530018 SPACE 1 37560016 LOADMAJ CL WORKREG0,NXMAJ(CURMAJ) Q. IS MAJOR PRESENT 37620016 BCR 8,RETREG NO, RETURN TO CALLER 37680016 SPACE 1 37740016 REPTEMAJ L CURMAJ,NXMAJ(CURMAJ) GET ADDRESS OF MAJOR QCB 37800016 CL WORKREG0,FSTMIN(CURMAJ) Q. IS THERE A MINOR 37860016 BC 8,FREMAJ NO MINOR, DEQUEUE MAJOR 37920016 SPACE 1 37980016 * THE SITUATION TESTED FOR ABOVE, A MAJOR QCB WITHOUT A 38040016 * MINOR QCB, CAN ARISE IF THE TASK WAS ABENDED FROM ENQ. 38100016 * IF WE FALL THROUGH TO HERE, THERE IS A MINOR QCB. 38160016 * NOTE THAT THERE CANNOT BE A MINOR QCB WITHOUT A QEL. 38220016 SPACE 1 38280016 LA WORKREG3,TESTMIN SET EXIT ADDRESS 38340016 L CURMIN,FSTMIN(CURMAJ) GET THE ADDRESS OF THE MINOR 38400016 REPTEMIN SR WORKREG1,WORKREG1 INITIALIZE INDICATOR 38460016 L CURQEL,FSTQEL(CURMIN) GET FIRST QEL 38520016 LTR CURQEL,CURQEL . IS THERE A QEL BJ A55316 38570021 BZ TESTMIN BJ A55316 38575021 CL CURTCB,QELTCB(CURQEL) Q. SHOULD IT BE DEQUEUED 38580016 LR WORKREG4,CURQEL YES, SAVE ADDRESS OF QEL M1336 38640020 BC 8,TSTNXT YES, TAKE BRANCH 38700016 TSTSHR TM QELCDS(CURQEL),NEGCODE Q. IS IT SHARED 38760016 BC 7,SKIP1 YES 38820016 BALR WORKREG1,0 NO, SET INDICATOR 38880016 SKIP1 BAL LINKREG,ISNXT GO GET NEXT 38940016 BCR 15,WORKREG3 EXIT, NO MORE QEL'S 39000016 BCR 0,0 PAD FOR VECTOR RETURN 39060016 LR CURQEL,WORKREG2 XFR QEL ADDRESS 39120016 CL CURTCB,QELTCB(CURQEL) Q. SHOULD IT BE DEQUEUED 39180016 BC 7,TSTSHR NO, TEST CODE AND GET NEXT 39240016 LR WORKREG4,CURQEL YES, SAVE ADDRESS OF QEL M1336 39300020 AIF (NOT &B(2)).SHRDA54 39307016 LTR WORKREG1,WORKREG1 Q. IS INDICATOR ON 39315016 BC 7,REMVE YES REMOVE THE QEL 39320016 TM QELCDS(CURQEL),RESERVED NO IS QEL A RESERVE 39325016 BC 8,SKIP2 NO TREAT NORMALLY 39330016 LR GENREG,UCBREG SAVE WORKREG3 39332016 L UCBREG,QELUCB(CURQEL) GET UCB POINTER 39333016 TM UCBID(UCBREG),UCBIDMSK UCB ADDR IN THE QEL 4531 39333420 BNO NOTUCB NO, THE SVRB IS STILL THERE 4531 39333820 CLI UCBNAME(UCBREG),UCBNMEMK IS THERE A DEV NAME 4531 39333920 BNH NOTUCB NO, THE SVRB STILL THERE 4531 39336820 BAL LINKREG,RLSETEST DECREMENT UCB COUNT 39339720 NOTUCB LR CURQEL,WORKREG4 RESTORE SAVED QEL POINTER M1336 39342620 LR WORKREG3,GENREG RESTORE WORKREG3 39345520 SR WORKREG1,WORKREG1 RESTORE INDICATOR TO ZERO 39348420 SKIP2 BAL LINKREG,ISNXT GO GET NEXT 39351320 AGO .SHRDA55 39354220 .SHRDA54 ANOP 39357120 LTR WORKREG1,WORKREG1 Q. IS INDICATOR ON 39360016 BC 7,REMVE YES, GO DIRECTLY TO DEQUEUE IT 39420016 BAL LINKREG,ISNXT GO GET NEXT 39480016 .SHRDA55 ANOP 39510016 BC 15,REMVE NO MORE QELS, REMOVE LAST 39540016 LTR GENREG,GENREG Q. IS NEXT QEL SHARED 39600016 BC 7,REMVE NO, GO DIRECTLY TO REMOVE 39660016 LTR WORKREG1,WORKREG1 Q. IS INDICATOR ON 39720016 BC 7,LOOP1 YES, RIPPLE DOWN AND ADJUST 39780016 TM QELCDS(CURQEL),NEGCODE Q. IS THIS QEL SHARED 39840016 BC 1,REMVE YES, GO REMOVE IT 39900016 LOOP1 BAL LINKREG,ISNXT GO GET NEXT 39960016 BC 15,REMVE NO MORE QELS, DEQUEUE CURRENT 40020016 LTR GENREG,GENREG Q. IS NEXT QEL SHARED 40080016 BC 7,REMVE NO, RIPPLE DONE, DQ CURRENT 40140016 L GENREG,SVRBPTR(WORKREG2) GET SVRB ADDRESS 40260016 LA LINKREG,LOOP1 SET RETURN REGISTER 40320016 REDUCE DS 0H 20021 40338020 LR CURQEL,WORKREG2 XFR QEL ADDR FOR INTERFCE 39399 40338420 AIF (NOT &B(3)).TSO0650 20021 40340020 TM QELTJID0(WORKREG2),ANYON QEL FOR TIME-SHARING USER 20021 40350020 BZ DECREMET NO DECREMENT COUNT 20021 40360020 * FLAG QEL FOR SVRB 20021 40361020 OI QELCDS(WORKREG2),QELRBWT PROCESSING AFTER SWAP 20021 40362020 LH REG0,QELTJID0(WORKREG2) GET TIME-SHARING USER'S 20021 40430020 IC REG0,QELTJID1(WORKREG2) IDENTIFICATION 20021 40431020 N REG0,TSDRVMSK CLEAR HIGH ORDER BYTE 20021 40432020 TSEVENT USERRDY,TJID=(0) 20021 40434020 BR LINKREG EXIT FOR DELAYED SVRB PROC 20021 40434120 DECREMET DS 0H 20021 40435020 .TSO0650 ANOP 20021 40436020 CLI RBWCF(GENREG),WAITIND Q. IS WAIT COUNT ZERO 40437020 BCR 8,LINKREG YES, DON'T DECREMENT 40440016 IC TASKTCB,RBWCF(GENREG) GET WAIT COUNT 40500016 BCTR TASKTCB,0 DECREMENT IT 40560016 STC TASKTCB,RBWCF(GENREG) PUT IT BACK 40620016 AIF (NOT &B(2)).SHRDA51 40624016 TM QELCDS(CURQEL),RESERVED Q. IS THIS QEL RESERVE QEL 40628016 BC 8,NORESV NO DO NOT INCREMENT UCB COUNT 40632016 L TASKTCB,QELUCB(CURQEL) YES GET SVRB PTR BJ 60112 40636021 L WORKREG2,RBSAVUCB(TASKTCB) GET PARM POINTER BJ 60112 40640021 ST WORKREG2,QELUCB(CURQEL) SET UCB POINTER IN QEL 40647016 SR WORKREG1,WORKREG1 CLEAR REG FOR IC 40648016 IC WORKREG1,UCBRSCT(WORKREG2) GET UCB RESERVE COUNT 40652016 LA WORKREG1,1(WORKREG1) BY ONE AND 40656016 STC WORKREG1,UCBRSCT(WORKREG2) REPLACE NEW RESERVE COUNT 40660016 LR WORKREG2,CURQEL RESTORE QEL SAVE REG 40662016 NORESV CLI RBWCF(GENREG),WAITIND Q. IS IT STILL WAITING 40664016 AGO .SHRDA52 40668016 .SHRDA51 ANOP 40672