TITLE 'IGG0CLCE - UPDATE, CLEANUP, ERROR PROCESSING' @YL026UD 00010037 * /* START OF SPECIFICATIONS **** 00020002 * 00030002 *01* MODULE-NAME = IGG0CLCE @YL026UD 00040002 *01* STATUS = 00 00050002 * 00060037 *01* DESCRIPTIVE-NAME = UPDATE, CLEANUP, OPEN, AND FORMAT @YL026UD 00130002 *01* FUNCTION = IGG0CLC6 - @YL026UD 00132002 * 1. CREATES A NEW UPDATED BLOCK. @YL026UD 00140002 * 2. RIPPLES THE UPDATE DOWN THE INDEX CHAIN. @YL026UD 00150002 * IGG0CLC7 - @YL026UD 00152002 * 1. WRITES THE LAST BLOCK OF AN UPDATE. @YL026UD 00154002 * 2. UPDATES THE ICE AND REWRITES IT. @YL026UD 00156002 * 3. UPDATES THE VICE AND REWRITES IT. @YL026UD 00158002 * 4. DEQUEUES ALL RESOURCES. @YL026UD 00158402 * 5. FREES ALL MAIN STORAGE. @YL026UD 00158802 * 6. SETS RETURN CODES. @YL026UD 00159202 * 7. CREATES AN ENVIRONMENT RECORD FOR @YL026UD 00159602 * NON-LOCATE ERROR CODES OF 8 AND 28. @YL026UD 00159702 * FOR AN OVERVIEW OF THIS MODULE AND ITS RELATIONSHIP WITH THE 00166702 * OTHER CATALOG MANAGEMENT MODULES, REFER TO THE CATALOG MANAGEMENT 00170002 * PLM, Y28-6606. 00180002 *01* NOTES = LABELS REFERED TO IN COMMENTARY ARE ENCLOSED IN SINGLE 00190002 * QUOTES. EQUATED CONSTANTS ARE PREFIXED WITH 'D' OR 'X' WHEN THEY 00200002 * ARE DECIMAL OR HEXADECIMAL RESPECTIVELY; FOR EXAMPLE, D12 EQU 12, 00210002 * AND X12 EQU X'12'. ERROR CODES ARE SET USING 'ERRORXX' AT 00220002 * CORRESPONDING LABELS, 'ERRXX'. BRANCHES ORIGINATE FROM LABELS 00230002 * 'IGG0CLCX'. FLAGS ARE LABELED 'FLAGX'. IO IS DONE FROM EITHER A 00240002 * SUBROUTINE NAMED 'CALLBLDL' OR A SUBROUTINE NAMED 'IO'. ADDRESS 00250002 * CONVERSION IS ACCOMPLISHED IN SUBROUTINES NAMED 'TOABSL' AND 00260002 * 'TORLTV'. THESE CONVENTIONS ARE FOLLOWED IN EVERY MODULE WHERE 00270002 * THE EVENT EXISTS. 00280002 *02* DEPENDENCIES = OPERATION OF THIS MODULE DEPENDS ON THE 00290002 * COLLATING SEQUENCE OF THE EXTERNAL CHARACTER SET. REDEFINITION 00300002 * OF THE CHARACTER CONSTANTS BY REASSEMBLY WILL RESULT IN A 00310002 * CORRECT MODULE. THE CONSTANTS IN QUESTION ARE PREFIXED WITH 00320002 * 'CCD', FOR 'CHARACTER CODE DEPENDENT'. 00330002 *02* PERFORMANCE = (IGG0CLC6) INHIBITS RIPPLING WHERE POSSIBLE 00340002 * AND ATTEMPTS MOVEMENT OF INDEX BLOCKS TO ATTAIN CONTIGUITY. 00350002 * (IGG0CLC7) REWRITES THE VICE OR ICE ONLY WHEN IT HAS 00352002 * BEEN MODIFIED. @YL026UD 00354002 *02* RESTRICTIONS = ALL DIRECT ACCESS STORAGE DEVICES EXCEPT 2321 00360002 * DATA CELL ARE SUPPORTED BY CATALOG MANAGEMENT. 00370002 *02* REGISTER-CONVENTIONS = REGISTERS ARE LABELED 'R0,R1,...,R15'. 00380002 * REQUIRED ADDITIONAL LABELS ARE EQUATED TO THESE. REGISTERS 00390002 * COMMON TO ALL MODULES OF CATALOG MANAGEMENT ARE 00400002 * R4 BASE REGISTER FOR THE MODULE. 00410002 * R6 BASE REGISTER FOR THE WORKAREA DSECT. 00420002 * R8 BASE REGISTER FOR THE CAMLSTD DSECT. 00430002 *02* PATCH-LABEL = 'FIXAREA' @YL026UD 00440002 *01* MODULE-TYPE = MODULE 00450002 *02* PROCESSOR = ASSEMBLER 00460002 *02* MODULE-SIZE = 4000 BYTES @YL026UD 00470002 *02* ATTRIBUTES = REENTERABLE, READ ONLY, ENABLED, SUPERVISORY MODE 00480002 *01* ENTRY = IGG0CLCE @YL026UD 00490002 *02* PURPOSE = (IGG0CLC6) ENTERED FOR ALL NON-LOCATE @YL026UD 00500002 * REQUESTS FOR THE UPDATING OF AN INDEX LEVEL. @YL026UD 00510002 * (IGG0CLC7) ENTERED FOR ALL NON-LOCATE REQUESTS TO @YL026UD 00512002 * FINISH THE UPDATING OF AN INDEX LEVEL AND TO INDICATE @YL026UD 00514002 * THE NEW STATUS OF THE SYSCTLG IN THE CONTROL ENTRIES. @YL026UD 00516002 * ALSO ENTERED TO PROCESS ERROR CONDITIONS AND RETURN @YL026UD 00518002 * CONTROL TO THE ISSUER OF SVC 26. @YL026UD 00518402 *02* LINKAGE = LINK @YL026UD 00520002 *02* INPUT = FOR IGG0CLC6 AND IGG0CLC7 CONSISTS OF 00530002 * . WORKAREA (BLDLAREA) 00540002 * . SVRB EXTENSION 00550002 * . DCB 00560002 * . DEB 00570002 * . CAMLST AND PARAMETERS 00580002 * . SYSCTLG 00590002 * IN ADDITION, IGG0CLC6 REQUIRES 00600002 * . 'READTTR' 00610002 * . 'NAME' 00620002 * . 'TTR0' 00630002 * . 'DATA' 00640002 * . OPTIONALLY THE BLOCK TO BE UPDATED 00650002 * IN ADDITION, IGG0CLC7 REQUIRES @YL026UD 00652002 * (NORMAL) @YL026UD 00654002 * . 'LINKTTR'--INDICATES BLOCK MAY BE FREED @YL026UD 00656002 * . 'WRITETTR'--WHERE TO WRITE LAST BLOCK @YL026UD 00658002 * . 'ICEPERT'--USED PART OF ICE @YL026UD 00658402 * . 'VICEPERT'--USED PART OF VICE @YL026UD 00658802 * . 'OUTPUT'--CONTAINS BLOCK TO BE WRITTEN @YL026UD 00659202 * . 'ERRCODE'--ZERO @YL026UD 00659602 * . R1--ZERO OR POSITIVE @YL026UD 00659702 * . R7--POINTER TO THE LINK ENTRY @YL026UD 00659802 * (ERROR) @YL026UD 00659902 * . 'ERRCODE'--CONTAINS CATALOG AND LOCATE ERROR CODES @YL026UD 00663202 * . R1 NEGATIVE--INDICATES IGC0002H RETURNED ERROR CODE @YL026UD 00665202 *02* OUTPUT = (IGG0CLC6) SEE INPUT FOR IGG0CLC7 @YL026UD 00686802 * (IGG0CLC7) NORMAL @YL026UD 00688802 * . R15 = 0 @YL026UD 00689202 * . UPDATED SYSCTLG @YL026UD 00689602 * (IGG0CLC7) ERROR @YL026UD 00690002 * . R15 = RETURN CODE @YL026UD 00693302 * . R0 = NUMBER OF LEVELS FOUND @YL026UD 00695302 * . R1 = LOCATE ERROR CODE @YL026UD 00695702 *02* EXIT-NORMAL = IGG0CLCA OR IGG0CLCB @YL026UD 00696802 *02* EXIT-ERROR = IGG0CLCA OR IGG0CLCB @YL026UD 00700102 *01* EXTERNAL-REFERENCES = AS FOLLOWS. 00703402 *02* ROUTINES = IECPRLTV, IECPCNVT 00706702 *02* DATA-SETS = SYSCTLG 00710002 *02* DATA-AREA = ALL DATA AREAS ARE DESCRIBED BY DSECTS AT THE END 00720002 * OF THE MODULE LISTING. 00730002 *01* TABLES = NONE 00740002 *01* MACROS = EXCP, WAIT, ESTAE, FREEMAIN, ENQ, DEQ, TIME, WTO 00750037 * 00751037 *01* CHANGE-ACTIVITY = NEW FOR RELEASE 21 00752037 * (AS IGG0CLC6,IGG0CLC7) 00753037 * RENAMED AND CHANGED FOR VS2 RELEASE 2 @YL026UD 00754037 * IGC0002H,IGG0CLF2 SPLIT OFF TO IGG0CLCF @OZ00006 00755037 * A127959 @OZ02274 00762737 *A10510-10520 @ZA02665 00763037 *A18770-18796 @ZA02665 00763637 *A127812-127829 @ZA02665 00764237 *A291390-291395 @ZA02665 00764837 * VS2 RELEASE 030 CHANGES 00765437 * A132620 @OZ03161 00765637 * A134100 @OZ04613 00765837 *A127810 @OZ05575 00766037 *A011910-012009,127830-127929,127957-127980,291395-291407 @OZ05908 00766637 *A127505 @OZ07534 00767237 * D128200,A128200,128620 @OZ07699 00767837 * VS2 RELEASE 037 CHANGES 00767937 * A018792,A046620-046680,A127890-127898,C127900,C291392 @OZ12193 00768037 * A098301-098305 @OZ12193 00768137 * D127505,A127852-127858 @OZ12244 00768237 *D011910-012009,A015101,A017401,A028400-028418 @OZ11109 00768337 *A127896,A127926,A127959,C291368,C291390,C291395 @OZ14802 00768437 *C128200,D128620 @OZ15062 00768808 *A142458,A292252 @OZ32432 00769208 * 00771237 **** END OF SPECIFICATIONS *******************************************/ 00773237 EJECT @YL026UD 00780002 IGG0CLCE CSECT @YL026UD 00790002 * 00792002 BALR BASE,0 SET BASE FOR MODULE 00800002 USING *,BASE ESTABL BASE FOR MODULE 00810002 USING CAMLSTD,R8 ESTABL BASE FOR CAMLST 00820002 USING ENTRY,R9 ESTABL BASE FOR ENTRY 00830002 USING WORKAREA,R6 ESTABL BASE FOR WORKAREA 00840002 * 00840402 B MODLABEL BRANCH AROUND MOD LABEL @YL026UD 00840502 DC C'IGG0CLCE ' MODULE IDENTIFIER @YL026UD 00840702 DC C'&SYSDATE' DATE OF ASSEMBLY 00841437 DC C'UZ20205' PTF LEVEL 00842108 DS 0H 00842537 MODLABEL EQU * 00842902 TITLE 'IGG0CLCE - (IGG0CLC6) SECOND LOAD OF UPDATE' @YL026UD 00845802 *********************************************************************** 00848002 * * 00850202 * IGG0CLC6 - SECOND LOAD OF UPDATE * 00852402 * * 00854602 *********************************************************************** 00856802 * @YL026UD 00859002 IGG0CLC6 EQU * #YL026UD 00861202 * 00863402 OI MODMAP1,MODCLC6 INDIC ENTRY TO IGG0CLC6 00865602 * 00867802 * SET ALL OTHER TASKS IN REGION NON-DISPATCHABLE 00870002 * 00880002 USING SVRBEXTD,R1 ESTABL ADDRBLTY TO SVRB EXT 00890002 L R1,SVRBEXTP SET BASE TO PARAMETER LIST 00900002 TM ENQFLAGS,SMCSTEP SMC ALREADY ISSUED? Y01965 00910002 BO SKIPSMC BRANCH IF YES Y01965 00920002 * 00930002 OI ENQFLAGS,SMCSTEP SET ENQ FLAGS Y01965 00940002 ENQ ,MF=(E,(1)) DISABLE STEP TASKS 00950002 DROP R1 00960002 * Y01965 00970002 SKIPSMC EQU * Y01965 00980002 * Y01965 00990002 * 01000002 * INITITALIZE 01010002 * 01020002 SR LENGTH,LENGTH ZERO 'LENGTH' Y01113 01030002 XC TTRS,TTRS ZERO 'WRITETTR, LINKTTR' Y01113 01040002 ST LENGTH,EXCLUDE ZERO 'EXCLUDE' Y01113 01050002 XC SAVEKEY,SAVEKEY SIMULATE PREVIOUS ZA02665 01051002 * ENTRY KEY = 0 ZA02665 01052002 XC OUTDATA,OUTDATA CLEAR THE OUTPUT BLOCK 01060002 LA OUT,OUTENTRY FIRST HOLE IN NEW BLOCK 01070002 TM FLAG3,NEEDBLK BLOCK FOR UPDATE IN? 01080002 BZ SETUP YES 01090002 * 01100002 BAL R10,GET NO, READ BLOCK FOR UPDATE 01110002 B COMPARE START THE UPDATE PROCESS 01120002 * 01130002 * 01140002 SETUP EQU * 01150002 * 01160002 BAL R10,GETSET SET UP TTRS 01170002 * 01180002 COMPARE EQU * 01190002 * 01201937 * COMPARE 4 BYTES OF GDG NAME OR 8 BYTES OF NON-GDG NAME 01210002 * AT 'IN' WITH UPDATE NAME. 01220002 * 01230002 * GO TO 'ADD' IF UPDATE NAME IS SMALLER, 01240002 * GO TO 'CHEKROOM' IF UPDATE NAME IS GREATER, 01250002 * GO TO NEXT INSTRUCTION ('DELETE') IF NAMES MATCH. 01260002 * 01270002 TM FLAG3,GDS * PROCESSING GDG? 01280002 BZ NONGDG NO 01290002 * 01300002 CLC GENNO,EGENNO YES, COMPARE GENERATION NUMBERS 01310002 B CRIT GO MAKE THE CC DECISION 01320002 * 01330002 * 01340002 NONGDG EQU * 01350002 * 01360002 CLC NAME,ENAME COMPARE ENTIRE NAMES 01370002 * 01380002 CRIT EQU * 01390002 * 01400002 BL ADD NEW IS LESS THAN EXISTING 01410002 * 01420002 BH CHEKROOM NEW IS GREATER THAN EXISTING 01430002 * 01440002 * DELETE NEW IS EQUAL TO EXISTING 01450002 * 01460002 * CALCULATE THE LENGTH OF THE ENTRY TO BE DELETED AND 01470002 * INCREMENT THE 'IN' POINTER SO THAT ENTRY WILL BE IGNORED. 01480002 * TURN THE COMPLETION SWITCH ON. GO TO NEXT INSTRUCTION 01490002 * ('ADD') IF REQUEST IS RECATALOG, OTHERWISE GO TO 'CHEKLINK'. 01500002 * 01510002 BAL BALREG3,EDITYPE GO EDIT ENTRY TYPE @OZ11109 01515037 IC LENGTH,ETYPE COUNT FIELD OF INPUT ENTRY 01520002 LA LENGTH,D12(LENGTH,LENGTH) LENGTH OF INPUT 01530002 AR IN,LENGTH STEP OVER ENTRY 01540002 OI FLAG4,UPDATED * SET UPDATE COMPLETE 01550002 TM FLAG1,RECATF RECAT? 01560002 BZ CHEKLINK NO 01570002 * 01580002 NI FLAG4,X'FF'-UPDATED * UPDATE NOT COMPLETE @OZ11109 01590037 * 01600002 ADD EQU * 01610002 * 01620002 * SAVE 'IN' AND SET UPDATE IN PROGRESS SWITCH TO INDICATE 'IN' 01630002 * IS IRREGULAR. LOAD 'IN' WITH ADDRESS OF UPDATE ENTRY. GO 01640002 * 01650002 ST IN,ADDING SAVE POINTER TO ENTRY 01660002 OI FLAG4,UPDATING * SET UPDATE IN PROGRESS 01670002 LA IN,NAME POINT TO NEW ENTRY 01680002 * 01690002 CHEKROOM EQU * 01700002 * 01710002 * COMPUTE LENGTH OF ENTRY TO BE MOVED (TO 'OUT'). 01720002 * CALL 'PUT' IF THERE IS NOT ENOUGH ROOM TO MOVE THE ENTRY. 01730002 * 01740002 BAL BALREG3,EDITYPE GO EDIT ENTRY TYPE @OZ11109 01745037 IC LENGTH,ETYPE COUNT FIELD OF INPUT ENTRY 01750002 LA LENGTH,D12(LENGTH,LENGTH) LENGTH OF INPUT ENTRY 01760002 * 01770002 * POINT TO FIRST CHARACTER OF LAST POSSIBLE LINK ENTRY 01780002 * 01790002 LA R1,OUTLKLMT 01800002 SR R1,OUT GET BYTES AVAILABLE 01810002 CR R1,LENGTH ROOM AVAILABLE? 01820002 BNL TRANS YES, GO MOVE THE ENTRY 01830002 * 01840002 BAL BALREG3,PUT ***GO WRITE THE BLOCK*** 01850002 * 01860002 TRANS EQU * 01870002 * ZA02665 01871002 * MAKE SURE THE NEXT ENTRY TO BE MOVED TO OUTPUT IS ZA02665 01872002 * OF A HIGHER KEY THAN THE PREVIOUS ONE. IF NOT, SET ZA02665 01873002 * A FLAG TO HAVE IGG0CLC7 WRITE A WARNING MESSAGE TO ZA02665 01874002 * THE OPERATOR THAT THE CATALOG NEEDS REPAIR. ZA02665 01875002 * ZA02665 01876002 CLC SAVEKEY,0(IN) TEST PREVIOUS KEY LESS ZA02665 01877002 * THAN NEXT KEY ZA02665 01878002 BL TRANS2 YES, OK ZA02665 01879002 OI FLAG2,SEQERR ENTRY OUT OF SEQUENCE @OZ02665 01879237 OI FLAG4,ERRORTTR SET ERROR HOLD FLAG @OZ12193 01879337 TRANS2 EQU * ZA02665 01879402 MVC SAVEKEY,0(IN) SAVE FOR NEXT TIME THRU ZA02665 01879602 * 01880002 * MOVE ENTRY AT 'IN' TO 'OUT' AND BUMP 'IN' TO POINT TO 01890002 * NEXT ENTRY TO BE MOVED. SAVE NAME MOVED IN CASE 01900002 * IT BECOMES A KEY. GO TO 'COMPARE' IF UPDATE IS NOT COMPLETE. 01910002 * 01920002 LR R1,LENGTH GET LENGTH OF ENTRY 01930002 BCTR R1,0 MINUS ONE FOR EXECUTE 01940002 EX R1,MOVE1 MVC 0(0,OUT),0(IN) 01950002 MVC OUTKEY,0(IN) SAVE AS A POSSIBLE KEY 01960002 TM FLAG4,UPDATING ADDING OR JUST MOVING? 01970002 BZ INCRIN JUST MOVING 01980002 * 01990002 L IN,ADDING RESTORE POINTER TO ENTRY 02000002 * 02010002 * TURN OFF 'UPDATING' SWITCH AND ON 'UPDATED' SWITCH 02020002 * 02030002 XI FLAG4,COMPLETE * SET UPDATE COMPLETE 02040002 B STABLIN DON'T INCR 'IN' 02050002 * 02060002 * 02070002 INCRIN EQU * 02080002 * 02090002 AR IN,LENGTH INCR 'IN' 02100002 * 02110002 STABLIN EQU * 02120002 * 02130002 AR OUT,LENGTH INCR 'OUT' 02140002 TM FLAG4,UPDATED * UPDATE COMPLETE? 02150002 BZ COMPARE NO 02160002 * 02170002 CHEKLINK EQU * 02180002 * 02190002 * CHECK NEXT ENTRY TO BE MOVED. GO TO 'CHEKROOM' IF IT IS NOT A 02200002 * LINK ENTRY. IF IT IS, GO TO 'NEXTLOAD' IF THE LINK IS ZERO 02210002 * AND GO TO NEXT INSTRUCTION 'READ' IF LINK IS NON-ZERO. 02220002 * 02230002 CLC ENAME,HIBIN IS NEXT ENTRY A LINK ENTRY? 02240002 BNE CHEKROOM NO 02250002 * 02260002 NC ETTR,ETTR IS LINK TTR ZERO? 02270002 BZ LAST YES, END OF INPUT 02280002 * 02290002 * UPDATE IS COMPLETE. THE NEXT ENTRY IN 'INPUT' IS A LINK ENTRY 02300002 * WITH A NON-ZERO TTR. 02310002 * 02320002 TM FLAG4,STOP * IS THIS THE FIRST BLOCK? 02330002 BC 11,CONTUPDT NO, CONTINUE UPDATE 02340002 * SA52084 02350002 * 'SLACK' IS NOT PERMITTED IN GDG PROCESSING SA52084 02360002 * SA52084 02370002 TM FLAG3,GDS GDG PROCESSING? SA52084 02380002 BO CONTUPDT YES, CONTINUE UPDATE SA52084 02390002 * 02400002 * CHECK UNUSED BYTES IN BLOCK. 02410002 * 02420002 * IF NUMBER OF UNUSED BYTES IS LESS THAN 'SLACK', THEN STOP 02430002 * THE UPDATE PROCESS, CONTINUE IF NOT. 02440002 * 02450002 LA R0,SLACK(OUT) ADD SLACK TO PTR 02460002 LA R1,OUTLKLMT GET LAST AVAIL BYTE ADDR 02470002 CR R0,R1 NO. OF UNUSED BYTES PERMSBLE? 02480002 BNL LAST YES 02490002 * 02500002 * READ A NEW INPUT BLOCK IF NECESSARY. 02510002 * 02520002 CONTUPDT EQU * 02530002 * 02540002 MVC READTTR,ETTR GET TTR OF NEXT BLOCK FOR UPDATE 02550002 BAL R10,GET ***READ IT IN*** 02560002 B CHEKLINK CHECK FIRST ENTRY 02570002 * 02580002 * 02590002 LAST EQU * 02600002 * 02610002 * PREPARE TO GO TO IGG0CLC7 FOR THE WRITING OF THE 02620002 * LAST BLOCK. 02630002 * 02640002 MVC 0(L'LNKENTRY,OUT),0(IN) MOVE IN THE ILE 02650002 BAL BALREG3,SETKEYCT SET KEY AND 'OUTBYTSU' 02660002 * 02670002 * FREE THE BLOCK AT 'LINKTTR' UNLESS IT IS BEING USED 02680002 * 02690002 DROP IN 02700002 USING ENTRY,OUT ESTABL ADDRBLTY TO LINK ENTRY 02710002 CLC ETTR,LINKTTR BLOCK AT 'LINKTTR' BEING USED? 02720002 BE DONTFREE YES, DON'T FREE THE BLOCK 02730002 * 02740002 MVC EXCLUDE,LINKTTR SET UP FOR 'KEY0WRIT' 02750002 BAL BALREG3,KEY0WRIT GO FREE THE BLOCK 02760002 BAL BALREG3,HOLE REPLACE 'VFHOLE' IF NECESSARY 02770002 DROP OUT 02780002 USING ENTRY,IN RE-ESTABL ADDRBLTY TO IN ENTRY 02790002 * 02800002 DONTFREE EQU * 02810002 * 02820002 B ERR00 GO TO IGG0CLC7 02830002 * 02840002 EJECT 02850002 ******************************* @OZ11109 02850437 * * 02850837 EDITYPE EQU * * @OZ11109 02851237 * * 02851637 * TEST FOR VALID RECORD TYPE * @OZ11109 02852037 ******************************* 02852437 CLI ETYPE,NCVOL @OZ11109 02852837 BNH ETYPEOK @OZ11109 02853237 CLI ETYPE,DSPE7 @OZ11109 02853637 BE ETYPEOK @OZ11109 02854037 CLI ETYPE,DSPED @OZ11109 02854437 BE ETYPEOK @OZ11109 02854837 CLI ETYPE,DSPE13 @OZ11109 02855237 BE ETYPEOK @OZ11109 02855637 CLI ETYPE,DSPE19 @OZ11109 02856037 BE ETYPEOK @OZ11109 02856437 CLI ETYPE,DSPE1F @OZ11109 02856837 BE ETYPEOK @OZ11109 02857237 MVI ERRCATSV,ERROR08 NOT A VALID ENTRY @OZ11109 02857637 OI FLAG2,ETYPERR @OZ11109 02858037 B IGG0CLC7 @OZ11109 02858437 ETYPEOK EQU * @OZ11109 02858837 BR BALREG3 @OZ11109 02859237 EJECT 02859637 * 02860002 **************** 02870002 * * 02880002 GET EQU * 02890002 * * 02900002 **************** 02910002 * 02920002 * IF 'LINKTTR' IS EMPTY OR EQUAL TO 'READTTR', CONTINUE. 02930002 * ELSE, EMPTY 'LINKTTR' BY CALLING 'PUT'. 02940002 * 02950002 NC LINKTTR,LINKTTR EMPTY? 02960002 BZ GETCHP YES 02970002 * 02980002 CLC LINKTTR,READTTR EQUAL TO 'READTTR'? 02990002 BE GETCHP YES 03000002 * 03010002 BAL BALREG3,PUT ***GO WRITE THE BLOCK*** 03020002 * 03030002 GETCHP EQU * 03040002 * 03050002 MVC NEXTKEY,HIBIN SET IN CASE NEXT KEY NOT READ 03060002 MVC OPTNCCW,RD MOVE IN READ DATA CCW 03070002 MVI RC,RKDOP MOVE IN READ KEY & DATA OP-CODE 03080002 MVI RC+4,SILI SUPPRESS INCORRECT LENGTH INDIC 03090002 CLC VHIREC,READTTR+2 LAST RECORD ON TRK? 03100002 BE GETREAD YES, DON'T READ NEXT KEY 03110002 * 03120002 OI OPTNCCW+4,CC COMMAND CHAIN 03130002 * 03140002 GETREAD EQU * 03150002 * 03160002 L R0,READTTR GET READ ADDRESS 03170002 BAL BALREG2,TOABSL CONVERT THE READ ADDRESS 03180002 * 03190002 * READ DATA INTO INPUT AND NEXT KEY IF ON SAME TRACK 03200002 * 03210002 BAL BALREG1,IO1 ***READ DATA & KEY*** 03220002 MVI RC,RCOP RESTORE RC CCW 03230002 MVI RC+4,CC 03240002 NI FLAG4,CONTIGLC * TURN OFF 'CONTIGL' BIT 03250002 BAL BALREG3,KEY0WRIT FREE THE BLOCK AT 'EXCLUDE' 03260002 * 03270002 * UPDATE 'WRITETTR' AND 'LINKTTR' AS APPROPRIATE TO THE PATTERN 03280002 * OF GETS AND PUTS FOR THIS REQUEST. 03290002 * 03300002 * IF 'WRITETTR' IS ZERO OR EQUAL TO 'READTTR' 03310002 * THEN SET 03320002 * 'WRITETTR' EQUAL TO 'READTTR', AND 03330002 * 'LINKTTR' FROM THE INDEX LINK ENTRY IN THE BLOCK JUST READ. 03340002 * 03350002 * IF 'WRITETTR' DOES NOT MEET THE ABOVE CONDITION, 03360002 * THEN SET 03370002 * 'LINKTTR' EQUAL TO 'READTTR'. 03380002 * 03390002 NC WRITETTR,WRITETTR OK TO PUT 'READTTR' HERE 03400002 BZ GETWRITE YES 03410002 * 03420002 CLC WRITETTR,READTTR IS 'READTTR' ALREADY HERE? 03430002 BE GETWRITE YES 03440002 * 03450002 * MUST SET 'LINKTTR' EQUAL TO 'READTTR' 03460002 * 03470002 NC NEXTKEY,NEXTKEY IS NEXT BLOCK AVAIL 03480002 BNZ GETLINK NO 03490002 * 03500002 * INDIC THAT BLOCK FOLLOWING 'LINKTTR' IS A FREE BLOCK 03510002 * 03520002 OI FLAG4,CONTIGL * TURN ON 'CONTIGL' BIT 03530002 * 03540002 GETLINK EQU * 03550002 * 03560002 MVC LINKTTR,READTTR SET 'LINKTTR' 03570002 B GETDONE PREPARE TO RETURN 03580002 * 03590002 * 03600002 GETWRITE EQU * 03610002 * 03620002 * SET 'WRITETTR' EQUAL TO 'READTTR' 03630002 * 03640002 NI FLAG4,CONTIGWC * 'WRITETTR' EQUALS ZERO 03650002 NC NEXTKEY,NEXTKEY IS THE NEXT BLOCK AVAILABLE? 03660002 BNZ GETSET NO 03670002 * 03680002 * INDIC THAT BLOCK FOLLOWING WRITETTR IS A FREE BLOCK 03690002 * 03700002 OI FLAG4,CONTIGW * TURN ON 'CONTIGW' BIT 03710002 * 03720002 GETSET EQU * 03730002 * 03740002 DROP IN 03750002 USING ENTRY,R1 EST ADDRBLTY TO LINK ENTRY 03760002 MVC WRITETTR,READTTR SET 'WRITETTR' 03770002 LH R1,INBYTSU NUMBER OF BYTES USED 03780002 LA R1,INPUT-L'LNKENTRY(R1) POINT TO LINK ENTRY 03790002 * 03800002 * SET 'LINKTTR' 03810002 * 03820002 MVC LINKTTR,ETTRTYPE MOVE IN LINK TTR & ZERO COUNT 03830002 * 03840002 GETDONE EQU * 03850002 * 03860002 * 03870002 * SAVE THE READ ADDRESS. LATER, IF A TTR BECOMES UNNEEDED 03880002 * BECAUSE OF REARRANGING FOR CONTIGUITY (IN 'PUT'), 03890002 * THE BLOCK AT THAT TTR MAY BE FREED IF IT HAS BEEN READ. 03900002 * 03910002 MVC SAVETTR,READTTR INDIC BLOCK IS IN 'INPUT' 03920002 XC READTTR,READTTR ZERO 'READTTR' 03930002 LA IN,INENTRY POINT TO FIRST ENTRY 03940002 BR R10 RETURN 03950002 * 03960002 DROP R1 03970002 * 03980002 EJECT 03990002 * 04000002 **************** 04010002 * * 04020002 PUT EQU * 04030002 * * 04040002 **************** 04050002 * 04060002 STM R10,R11,SVAREA2X BALREG3 EQU R11 04070002 BAL BALREG2,PUTINCR GET TTR FOLLOWING WRITETTR 04080002 * 04090002 * LOOK FOR CONTIGUITY 04100002 * 04110002 C R1,LINKTTR ALREADY CONTIGUOUS? 04120002 BE PUTWRITE YES 04130002 * 04140002 LR NEXTTTR,R1 SAVE 'NEXTTTR' 04150002 * IS NEXT BLOCK THE FIRST AVAIL? SA52119 04160002 CL NEXTTTR,VFHOLE SA52119 04170002 BE PUTFHOLE YES, USE IT 04180002 * 04190002 TM FLAG4,CONTIGW IS NEXT BLOCK FREE? 04200002 BO PUTNEXT YES, USE IT 04210002 * 04220002 B PUTHOLE CONTIGUITY IMPOSSIBLE 04230002 * 04240002 * 04250002 PUTFHOLE EQU * 04260002 * 04270002 BAL BALREG3,KEY0PREP PREPARE TO FREE A BLOCK 04280002 BAL BALREG3,HOLE MAINTAIN VFHOLE 04290002 B PUTHOLE GO SET 'LINKTTR' 04300002 * 04310002 * 04320002 PUTNEXT EQU * 04330002 * 04340002 BAL BALREG3,KEY0PREP PREPARE TO FREE A BLOCK 04350002 ST NEXTTTR,LINKTTR USE 'NEXTTTR' 04360002 B PUTWRITE TTRS ARE SET 04370002 * 04380002 * 04390002 PUTHOLE EQU * 04400002 * 04410002 NC LINKTTR,LINKTTR LINKTTR = 0? 04420002 BNZ PUTWRITE NO, 'LINKTTR' SET OK 04430002 * 04440002 L R0,VFHOLE GET TTR OF FIRST HOLE 04450002 BAL BALREG3,SWAP SET 'LINKTTR' = 'VFHOLE' 04460002 BAL BALREG2,TOABSL GO TO CONVERT 04470002 MVC OPTNCCW,TIC2 MOVE IN SEARCH CCW 04480002 BAL BALREG1,IO1 ***SEARCH FOR KEY=0*** 04490002 BAL BALREG2,TORLTV GET ITS TTR 04500002 ST R0,VFHOLE MAINTAIN 'VFHOLE' 04510002 * 04520002 PUTWRITE EQU * 04530002 * 04540002 USING ENTRY,OUT ESTABL ADDRBLTY TO ENTRY 04550002 MVC EINDEX,LNKENTRY MOVE IN ILE 04560002 BAL BALREG3,SETKEYCT GO SET KEY & 'OUTBYTSU' 04570002 MVC OPTNCCW,WKD MOVE IN WRITE KEY & DATA CCW 04580002 BAL BALREG1,IO1 ***WRITE KEY AND DATA*** 04590002 * 04600002 * VERIFY THE WRITE OPERATION 04610002 * 04620002 MVC OPTNCCW,RKD MOVE IN CCW--NO TRANSFER 04630002 BAL BALREG1,IO1 ***READ KEY AND DATA*** 04640002 XC OUTDATA,OUTDATA CLEAR THE OUTPUT BLOCK 04650002 TM FLAG4,ERRORTTR ERROR HOLD ON? @OZ12193 04661037 BNO STORTTR YES - FALL THROUGH @OZ12193 04662037 MVC CONWORK(4),WRITETTR SAVE FOR MSG IEC304I @OZ12193 04663037 NI FLAG4,X'FF'-ERRORTTR TURN ERROR HOLD OFF @OZ12193 04664037 STORTTR EQU * 04665037 MVC WRITETTR,LINKTTR SET NEW 'WRITETTR' 04667037 XC LINKTTR,LINKTTR ZERO 'LINKTTR' 04670002 OI FLAG4,WROTE * INDIC FIRST BLOCK WRITTEN 04680002 NI FLAG4,CONTIGC * TURN OFF ALL CONTIG SW 04690002 LM R10,R11,SVAREA2X BALREG3 EQU R11 04700002 LA OUT,OUTENTRY POINT TO FIRST ENTRY SLOT 04710002 BR BALREG3 RETURN 04720002 * 04730002 EJECT 04740002 * 04750002 **************** 04760002 * * 04770002 PUTINCR EQU * 04780002 * * 04790002 **************** 04800002 * 04810002 L R1,WRITETTR GET TTR TO INCREMENT 04820002 CLC VHIREC,WRITETTR+2 END OF TRACK? 04830002 BE PUTINCRT YES, INCREMENT TRACK 04840002 * 04850002 A R1,ONEREC INCREMENT RECORD SA53646 04860002 BR BALREG2 RETURN 04870002 * 04880002 * 04890002 PUTINCRT EQU * 04900002 * 04910002 SRL R1,D16 SHIFT OUT THE R 04920002 LA R1,X01(R1) INCREMENT TT 04930002 SLL R1,D16 REPOSITION TTR IN REG 04940002 A R1,ONEREC SET R TO 1 SA53646 04950002 BR BALREG2 RETURN 04960002 * 04970002 EJECT 04980002 * 04990002 **************** 05000002 * * 05010002 KEY0PREP EQU * 05020002 * * 05030002 **************** 05040002 * 05050002 MVC EXCLUDE,LINKTTR SAVE TTR OF BLOCK TO BE FREED 05060002 CLC EXCLUDE,SAVETTR BLOCK BEEN READ? 05070002 BE KEY0WRIT YES, GO FREE IT 05080002 * 05090002 MVC LINKTTR,HIBIN SET LINKTTR TO FF 05100002 BR BALREG3 RETURN 05110002 * 05120002 * 05130002 KEY0WRIT EQU * 05140002 * 05150002 NC EXCLUDE,EXCLUDE IS TTR ZERO? 05160002 BCR 8,BALREG3 YES, NOTHING TO FREE, RETURN 05170002 * 05180002 L R0,EXCLUDE TTR OF BLOCK TO FREE 05190002 BAL BALREG2,TOABSL GO CONVERT IT 05200002 MVC OPTNCCW,NOP MOVE IN SKELETON CCW 05210002 MVI OPTNCCW,WKDOP MOVE IN WRITE KEY & DATA CCW 05220002 BAL BALREG1,IO1 WRITE ZERO KEY AND BLOCK 05230002 XC EXCLUDE,EXCLUDE BLOCK IS FREED 05240002 BR BALREG3 RETURN 05250002 * 05260002 EJECT 05270002 * 05280002 **************** 05290002 * * 05300002 SETKEYCT EQU * 05310002 * * 05320002 **************** 05330002 * 05340002 LR R10,BASE MAKE R10 BIG 05350002 BAL BALREG2,PUTINCR GO INCREMENT 'WRITETTR' 05360002 ST R1,SAVETTR3 SAVE TTR OF NEXT BLOCK 05370002 CLC ETTR,SAVETTR3 SHOULD KEY INDIC CONTIGUITY? 05380002 BNE SETKEY NO, GO RESET KEY 05390002 * 05400002 XR R10,R10 YES, CHECK FOR EXTENT BOUNDARY 05410002 L R0,SAVETTR3 GET LINK TTR 05420002 BAL BALREG2,TOABSL GO TO CONVERT 05430002 IC R10,IOBSKADD SAVE THE 'M' 05440002 * 05450002 SETKEY EQU * 05460002 * 05470002 L R0,WRITETTR GET WRITE TTR 05480002 BAL BALREG2,TOABSL GO TO CONVERT 05490002 IC R15,IOBSKADD PICK UP 'M' 05500002 CR R10,R15 ARE 'M'S EQUAL? 05510002 BE SETCOUNT YES 05520002 * 05530002 MVC OUTKEY,HIBIN SET KEY TO ALL X'FF' 05540002 * 05550002 SETCOUNT EQU * 05560002 * 05570002 LA R10,L'EINDEX(OUT) BUMP 'OUT' AROUND ILE 05580002 LA R0,OUTDATA POINT TO START OF BLOCK 05590002 SR R10,R0 GET BYTES USED 05600002 STH R10,OUTBYTSU SET BYTES USED 05610002 BR BALREG3 RETURN 05620002 * 05630002 DROP OUT 05640002 * 05650002 EJECT 05660002 * 05670002 **************** 05680002 * * 05690002 HOLE EQU * 05700002 * * 05710002 **************** 05720002 * 05730002 CLC VFHOLE,LINKTTR NEED TO UPDATE VFHOLE? 05740002 BH SWAP YES 05750002 * 05760002 XC LINKTTR,LINKTTR NO, DISPOSE LINKTTR 05770002 BR BALREG3 RETURN 05780002 * 05790002 * 05800002 SWAP EQU * 05810002 * 05820002 XC VFHOLE,LINKTTR START THE SWAP 05830002 XC LINKTTR(L'VFHOLE),VFHOLE 05840002 XC VFHOLE,LINKTTR SWAP COMPLETE 05850002 BR BALREG3 RETURN 05860002 * 05870002 EJECT 05872002 * 05880002 **************** 05890002 * * 05900002 TOABSL EQU * 05910002 * * 05920002 **************** 05930002 * 05940002 * FUNCTION: 05950002 * CONVERT THE TTR0 IN R0 TO AN ABSOLUTE DASD ADDRESS AND 05960002 * PUT IT INTO THE IOB MBBCCHHR 05970002 * 05980002 * INPUT: 05990002 * R0 IS THE TTR0 TO BE CONVERTED 06000002 * RETURN ADDRESS IN BALREG2 06010002 * 06020002 * OUTPUT: 06030002 * ABSOLUTE DASD ADDRESS IN IOB 06040002 * ERROR CODE IN R15 06050002 * 06060002 * DESTROYED: 06070002 * REGISTERS - R0,R1,R2,R14, AND R15=0 06080002 * WA - SAVEAREA AND MBBCCHHR OF THE IOB 06090002 * 06100002 * SUBROUTINES USED: 06110002 * THE RESIDENT CONVERT ROUTINE - IECPCNVT 06120002 * 06130002 * 06140002 **************** 06150002 **************** 06160002 * 06170002 L R15,EPTOABSL GET CONVERT ADDRESS FROM WA 06180002 B CONVERT USE COMMON CODE 06190002 EJECT 06200002 * 06210002 **************** 06220002 * * 06230002 TORLTV EQU * 06240002 * * 06250002 **************** 06260002 * 06270002 * FUNCTION: 06280002 * MOVE THE DASD ADDRESS OF CCHHR FROM NXTCNT INTO THE CCHHR OF THE 06290002 * IOB. THIS GIVES THE TTR OF THE NEXT FREE BLOCK. 06300002 * 06310002 * INPUT: 06320002 * RETURN IN BALREG2 06330002 * UPDATED NXTCNT 06340002 * 06350002 * OUTPUT: 06360002 * TTR0 IN R0 06370002 * 06380002 * DESTROYED: 06390002 * REGISTERS -- R0,R1,R2,R14, AND R15=0 06400002 * WA -- SAVEAREA AND CCHHR OF IOB 06410002 * 06420002 * SUBROUTINES USED: 06430002 * THE RESIDENT CONVERT ROUTINE -- IECPRLTV 06440002 * 06450002 * 06460002 **************** 06470002 **************** 06480002 * 06490002 MVC IOBSKADD+3(L'NXTCCHHR),NXTCCHHR MOVE COUNT FIELD 06500002 * 06510002 L R15,EPTORLTV GET ADDRESS OF ROUTINE FROM WA 06520002 * 06530002 * 06540002 CONVERT EQU * 06550002 * 06560002 * THE FOLLOWING SECTION IS COMMON TO BOTH ROUTINES 06570002 * 06580002 STM R9,R13,SAVEAREA SAVE REGS DESTROYED BY CONVERT 06590002 L R1,DEBADDR GET DEB ADDRESS 06600002 LA R2,IOBSKADD POINT TO MBBCCHHR 06610002 BALR BALREG1,R15 GO TO CONVERT ROUTINE 06620002 LM R9,R13,SAVEAREA RESTORE REGISTERS 06630002 BR BALREG2 RETURN TO CALLER 06632002 EJECT 06640002 * 06650002 **************** 06660002 * * 06670002 IO1 EQU * 06680002 * * 06690002 **************** 06700002 * 06710002 * FUNCTION: 06720002 * 1. IF THE DEVICE HAS THE RPS FEATURE, THE SET SECTOR CCW IS 06730002 * UPDATED. 06740002 * 2. ISSUE EXCP FOR THE CHANNEL PROGRAM POINTED TO BY THE IOB. 06750002 * 3. WAIT FOR THE OPERATION TO COMPLETE AND CHECK THE ECB. 06760002 * 4. IF AN END OF EXTENT CONDITION, BRANCH TO IGC0002H @YL026UD 06770002 * AND EXTEND THE CATALOG. @YL026UD 06780002 * 5. IF A PERMANENT I/O ERROR, SET AN ERROR CODE AND XCTL TO 06790002 * IGG0CLC7. 06800002 * 06810002 * INPUT: 06820002 * UPDATED CHANNEL PROGRAM 06830002 * RETURN ADDRESS IN BALREG 1 06840002 * 06850002 * OUTPUT: 06860002 * 1. FILLED BUFFER 06870002 * 2. EMPTIED BUFFER 06880002 * 3. ANOTHER FREE BLOCK ADDRESS 06890002 * 06900002 * DESTROYED: 06910002 * REGISTERS R0,R1,R15 (IF EXTENDS), AND ERRCAT 06920002 * 06930002 * EXTERNAL ROUTINES USED: 06940002 * EXCP, WAIT, IGC0002H TO EXTEND CATALOG @YL026UD 06950002 * 06960002 * EXITS: 06970002 * IGC0002H TO EXTEND THE CATALOG @YL026UD 06980002 * IGG0CLC7 FOR PERMANENT I/O ERROR 06990002 *** 07000002 * 07010002 USING RPSD,R1 ESTABL ADDRBLTY TO RPS WORKAREA 07020002 TM FLAG2,RPSDEV * RPS FEATURE? 07030002 BZ EXCP1 BRANCH IF NO 07040002 * 07050002 L R1,RPSAVEP GET RPS SAVE AREA PTR 07060002 STM R9,R2,RPSAVE SAVE REGS DESTROYED BY CONVERT 07070002 LM R15,R2,RPSINPUT GET CONVERT INPUT PARAMETERS 07080002 IC R0,IOBSKADD+7 GET R OF CCHHR 07090002 BALR R14,R15 CONVERT R TO THETA 07100002 LM R9,R2,RPSAVE RESTORE REGISTERS 07110002 * 07120002 EXCP1 EQU * 07130002 * 07140002 EXCP IOB ISSUE EXCP 07150002 WAIT ECB=ECB WAIT FOR REQUEST 07160002 CLI ECB,X7F I/O ERROR? 07170002 BCR 8,BALREG1 RETURN IF NO 07180002 * 07190002 CLC OPTNCCW,TIC2 SEARCHING FOR NEXT HOLE? 07200002 BNE ERR28 NO 07210002 * 07220002 CLI ECB,X42 END OF EXTENT? @OZ00006 07222002 BNE ERR28 NO, SET I/O ERROR @OZ00006 07224002 MVI VFHOLE,XFF INDIC CATALOG FULL 07230002 B PUTWRITE RETURN 07240002 * 07250002 DROP R1 07260002 * 07270002 EJECT 07280002 * 07290002 ERR28 EQU * 07300002 * 07310002 MVI ERRCATSV,ERROR28 RETURN CODE IS 28 @YL026UD 07320002 B IGG0CLC7 GO TO ERROR MODULE @YL026UD 07330002 * 07340002 * 07350002 ERR00 EQU * 07360002 * 07370002 XR R1,R1 SET FOR NORMAL EXIT 07380002 XC ERRCODE,ERRCODE RETURN CODE IS 00 07390002 B IGG0CLC7 07392002 * 07400002 TITLE 'IGG0CLCE - (IGG0CLC7) THIRD LOAD OF UPDATE AND CLEANUP' 08440002 *********************************************************************** 08490002 * * 08540002 * IGG0CLC7 - THIRD LOAD OF UPDATE AND CLEANUP * 08590002 * * 08640002 *********************************************************************** 08690002 * @YL026UD 08740002 ENTRY IGG0CLC7 @YL026UD 09512002 * 09514002 IGG0CLC7 EQU * @YL026UD 09520002 * 09526002 BALR BASE,0 SET BASE FOR MODULE 09536002 USING *,BASE ESTABL BASE FOR MODULE 09546002 * 09548002 USING ENTRY,R7 ESTABL BASE FOR ENTRY DSECT 09550002 USING WORKAREA,R6 ESTABL BASE FOR WORKAREA 09560002 USING CAMLSTD,R8 ESTABL BASE FOR CAMLST 09570002 USING SVRBEXT,R5 ESTABL BASE FOR SVRB EXTN 09580002 * 09582002 OI MODMAP1,MODCLC7 INDIC ENTRY TO IGG0CLC7 09590002 L R5,SVRBEXTP SET BASE FOR SVRB EXTN 09600002 * 09610002 * IF R1 IS NEGATIVE, THEN AN ERROR OCCURRED IN 'OPENEXT', AS 09620002 * CALLED FROM A PREVIOUS MODULE 09630002 * 09640002 LCR R1,R1 NEGATIVE? 09650002 BP ERR2H BRANCH IF YES 09660002 * 09670002 NC ERRCODE,ERRCODE ERROR TO PROCESS? SA52062 09680002 BNZ ERREXIT BRANCH AND PROCESS ERROR SA52062 09690002 * SA52062 09700002 EJECT 09710002 * 09720002 * COMPLETE THE UPDATE 09730002 * . WRITE THE LAST BLOCK OF THE UPDATE 09740002 * . UPDATE THE ICE IF NECESSARY 09750002 * . UPDATE THE VICE IF NECESSARY 09760002 * . CHECK FOR THE NEED TO EXTEND THE SYSCTLG DATA SET 09770002 * 09780002 * THE BLOCK IN 'OUTPUT' IS THE LAST BLOCK OF THE UPDATE. 09790002 * SET UP TO WRITE KEY & DATA FROM 'OUTPUT'. 09800002 * 09810002 L R0,WRITETTR GET THE WRITE ADDR 09820002 BAL BALREG2,TOABSL1 GO TO CONVERT 09830002 TM FLAG4,ERRORTTR ERROR HOLD ON? @OZ12193 09831037 BNO DONTSAVE YES - FALL THROUGH @OZ12193 09832037 MVC CONWORK(4),WRITETTR SAVE FOR MSG IEC304I @OZ12193 09833037 NI FLAG4,X'FF'-ERRORTTR TURN ERROR HOLD OFF @OZ12193 09834037 DONTSAVE EQU * 09835037 MVC OPTNCCW,WKD MOVE IN WRITE KEY & DATA OP-CODE 09840002 * 09850002 * THE BLOCK MAY CONTAIN THE ICE FOR THE LEVEL OR IT MAY CONTAIN 09860002 * THE VICE. IT IS CHECKED FOR THESE TWO POSSIBILITIES 09870002 * AND HANDLED ACCORDING TO THE FOLLOWING DECISION TABLE. 09880002 * 09890002 * 'Y' INDICATES THE REFERENCED BIT IN 'FLAG5' IS '1'B. 09900002 * 'N' INDICATES THE REFERENCED BIT IN 'FLAG5' IS '0'B. 09910002 * 09920002 * --------------------------------------------------------------- 09930002 * | |'FLAG5'| 1 2 3 4 5 6 7 8 9 A B | 09940002 * --------------------------------------------------------------- 09950002 * | BLOCK CONTAIN ICE OR VICE? | 'FST' | Y Y N N N N N Y Y Y | 09960002 * | 'XLSTBLK' FIELD REQ UPDATE? | 'LST' | N Y Y Y Y Y Y N N Y N | 09970002 * | NEW 'VFHOLE'? | 'VFH' | N N Y N Y Y N Y Y Y | 09980002 * | UPDATE IN LOW LEVEL INDEX? | 'LIN' | Y Y Y Y N N Y N N | 09990002 * --------------------------------------------------------------- 10000002 * | UPDATE 'VLSTBLK' | X X X | 10010002 * --------------------------------------------------------------- 10020002 * | 'VICE' TO 'OUTPUT' | 'MOVEVICE' | X X | 10030002 * | WRITE 'OUTPUT' | 'WRITVICE' | X X X | 10040002 * | CHECK FOR CATALOG FULL | | X X X | 10050002 * | WRITE 'OUTPUT' | 'READICE' | X X | 10060002 * | READ IN ICE BLOCK | | X X | 10070002 * | 'ILSTBLK' TO 'INPUT' | | X X | 10080002 * | WRITE 'INPUT' | | X X | 10090002 * | 'ILSTBLK' TO 'OUTPUT' | 'MOVEICE' | X X | 10100002 * | WRITE 'OUTPUT' | 'WRITICE' | X X X X X X | 10110002 * | READ IN VICE BLOCK | 'READVICE' | X X X X X X | 10120002 * | 'VICE' TO 'INPUT' | | X X X X X X | 10130002 * | WRITE 'INPUT' | | X X X X X X | 10140002 * | CHECK FOR CATALOG FULL | 'CHEKSPAC' | X X X X X X | 10150002 * --------------------------------------------------------------- 10160002 * 10170002 EJECT 10180002 * 10190002 * SET SWITCHES IN 'FLAG5', 'VFHOLE' AND 'VLSTBLK' 10200002 * 10210002 CLI ITYPE,ICETYP UPDATING LOW LEVEL? 10220002 BNE VIUPDATE NO, UPDATING THE VOL INDEX 10230002 * 10240002 OI FLAG5,LIN * SET LOW LEVEL INDEX SWITCH 10250002 MVC TEMPBUFF(L'ICEPERT),ICEPERT GET PERT PORTION OF ICE 10260002 B FSTCHEK GO CHECK FOR 'FST' 10270002 * 10280002 * 10290002 VIUPDATE EQU * 10300002 * 10310002 MVC TEMPBUFF(L'VICEPERT),VICEPERT GET PERT PORTION OF VICE 10320002 MVC FSTBLK,TTRVFST FIRST BLOCK OF VOLUME INDEX 10330002 * 10340002 FSTCHEK EQU * 10350002 * 10360002 CLC FSTBLK,WRITETTR WRITING THE FIRST BLOCK? 10370002 BNE LSTCHEK NO, GO CHECK FOR 'LST' 10380002 * 10390002 OI FLAG5,FST * SET FIRST BLOCK SWITCH 10400002 * 10410002 LSTCHEK EQU * 10420002 * 10430002 NC ETTR,ETTR WRITING THE LAST BLOCK? 10440002 BNZ VFHCHEK NO, GO CHECK 'VFH' 10450002 * 10460002 CLC LSTBLK,WRITETTR LAST BLOCK PROPERLY INDIC? 10470002 BE VFHCHEK YES, GO CHECK FOR 'VFH' 10480002 * 10490002 OI FLAG5,LST * SET 'LST' SWITCH 10500002 TM FLAG5,LIN * LOW LEVEL UPDATE? 10510002 BO VFHCHEK YES, DON'T RESET 'VLSTBLK' 10520002 * 10530002 MVC VLSTBLK,WRITETTR RESET 'VLSTBLK' 10540002 * 10550002 VFHCHEK EQU * 10560002 * 10570002 CLC VSAVE,VICESAVE NEED TO UPDATE VICE? 10580002 BE ROUTE NO 10590002 * 10600002 OI FLAG5,VFH * YES, SET 'VFH' SWITCH 10610002 * 10620002 EJECT 10630002 * 10640002 ROUTE EQU * 10650002 * 10660002 TM FLAG5,LST+VFH * TAKE THE 'WRITVICE' ENTRY? 10670002 BZ WRITVICE YES 10680002 * 10690002 TM FLAG5,FST+LST+LIN * TAKE THE 'MOVEICE' ENTRY? 10700002 BO MOVEICE YES 10710002 * 10720002 TM FLAG5,LST+LIN * TAKE THE 'READICE' ENTRY? 10730002 BO READICE YES 10740002 * 10750002 TM FLAG5,FST * TAKE THE 'WRITICE' ENTRY? 10760002 BZ WRITICE YES 10770002 * 10780002 TM FLAG5,LIN * TAKE THE 'MOVEVICE' ENTRY? 10790002 BO WRITICE NO 10800002 * 10810002 * FALL THRU TO 'MOVEVICE' 10820002 * 10830002 EJECT 10840002 * 10850002 MOVEVICE EQU * 10860002 * 10870002 MVC OUTENTRY+L'VNAME(L'VICEPERT),VICEPERT VICE TO 'OUTPUT' 10880002 * 10890002 WRITVICE EQU * 10900002 * 10910002 BAL BALREG4,WRITE ***WRITE KEY & DATA*** 10920002 B CHEKSPAC CHECK FOR CATALOG FULL 10930002 * 10940002 * 10950002 READICE EQU * 10960002 * 10970002 BAL BALREG4,WRITE ***WRITE KEY & DATA*** 10980002 L R0,IFSTBLK TTR OF ICE 10990002 IC R0,ZERO ZERO ALIAS COUNT 11000002 BAL BALREG4,READ ***READ ICE DATA*** 11010002 MVC INENTRY+L'INAME(L'ILSTBLK),WRITETTR MOVE IN NEW ICE 11020002 BAL BALREG4,WRITE ***WRITE ICE DATA*** 11030002 TM FLAG5,VFH * OK TO QUIT UPDATE? 11040002 BZ EXITCODE YES 11050002 * 11060002 B READVICE NO, VICE NEEDS UPDATING 11070002 * 11080002 * 11090002 MOVEICE EQU * 11100002 * 11110002 MVC OUTENTRY+L'INAME(L'ILSTBLK),WRITETTR UPDATE ICE 11120002 * 11130002 WRITICE EQU * 11140002 * 11150002 BAL BALREG4,WRITE ***WRITE KEY & DATA*** 11160002 CLI FLAG5,FST+LST+LIN * OK TO QUIT UPDATE? 11170002 BE EXITCODE YES 11180002 * 11190002 READVICE EQU * 11200002 * 11210002 LA R0,X0100 GET TTR OF VICE 11220002 BAL BALREG4,READ ***READ VICE DATA*** 11230002 MVC INENTRY+L'VNAME(L'VICEPERT),VICEPERT VICE TO 'INPUT' 11240002 BAL BALREG4,WRITE ***WRITE VICE DATA*** 11250002 EJECT 11260002 * 11270002 CHEKSPAC EQU * 11280002 * 11290002 CLI VFHOLE,XFF IS CATALOG FULL? 11300002 BNE EXITCODE NO, FUNCTION IS COMPLETE 11310002 * 11320002 * CATALOG IS FULL. ATTEMPT TO EXTEND BY STARTING AT THE LAST 11330002 * BLOCK IN THE CATALOG AND SEARCHING FOR KEY=0. 11340002 * 'IO' WILL BRANCH TO IGC0002H TO EXTEND. @YL026UD 11350002 * 11360002 * IF A NEW EXTENT IS AVAILABLE, CONTROL WILL RETURN AND 'VFHOLE' 11370002 * WILL BE UPDATED IN THE ALREADY WRITTEN VICE. 11380002 * 11390002 * IF NO NEW EXTENT IS AVAILABLE, CONTROL WILL GO TO THE 11400002 * EXITING CODE AND THE VICE WILL REMAIN INDICATING CATALOG 11410002 * FULL. 11420002 * 11430002 MVC OPTNCCW,TIC2 TO SEARCH KEY=0 11440002 MVC VFHOLE,VICESAVE PUT ON WORD BDY YM5075 11450002 L R0,VFHOLE TTR OF ORIGINAL 'VFHOLE' YM5075 11460002 BAL BALREG2,TOABSL1 GO TO CONVERT 11470002 BAL BALREG1,IO2 ***SEARCH KEY=0*** 11480002 BAL BALREG2,TORLTV1 GO TO CONVERT 11490002 ST R0,VFHOLE UPDATE 'VFHOLE' 11500002 * 11510002 * 'VCLSTBLK' IS UPDATED BY IGC0002H @YL026UD 11520002 * 11530002 B READVICE UPDATE VICE 11540002 * 11550002 EJECT 11560002 * 11570002 ERREXIT EQU * 11580002 * 11590002 TM FLAG1,LOCATEF LOCATE? 11600002 BO EXITCODE BRANCH IF YES 11610002 * 11620002 CLI VTYPE,VICETYP IS VICE IN CORE? 11630002 BNE EXITCODE BRANCH IF NO AND DON'T CREATE ER 11640002 * 11650002 * SAVE REGISTERS IN CASE AN ENVIRONMENT RECORD IS CREATED. 11660002 * 11670002 LA R15,OUTPUT SET TEMPORARY BASE FOR ER 11680002 USING EREC,R15 11690002 STM R0,R14,EREGSAV SAVE REGS EXCEPT R15 11700002 LR R9,R15 SET PERMANENT BASE FOR ER 11710002 DROP 15 11720002 USING EREC,R9 11730002 CLI ERRCATSV,ERROR08 CATALOG ERROR=8? 11740002 BE ER BRANCH IF YES AND CREATE ER 11750002 * 11760002 * CREATE AN ENVIRONMENT RECORD FOR ALL ERROR CODES 28 OR GREATER 11770002 * 11780002 CLI ERRCATSV,ERROR28 I/O ERROR? 11790002 BL EXITCODE BRANCH IF NO 11800002 * 11810002 * 11820002 ER EQU * 11830002 * 11840002 * SAVE THE IOB AND OPTION CCW ('OPTNCCW') SO MORE I/O MAY BE 11850002 * DONE AND NOT INVALID THE ENVIRONMENT RECORD 11860002 * 11870002 MVC ERIOB,IOB SAVE OLD IOB 11880002 MVC EROPTNCC,OPTNCCW SAVE OPTION CCW 11890002 * 11900002 * IF THE LAST BLOCK OF THE DATA SET ('VCLSTBLK') IS AVAILABLE 11910002 * (KEY FIELD ZERO), THEN THE ENVIRONMENT RECORD (SEE EREC DSECT 11920002 * FOR A DESCRIPTION) MAY BE WRITTEN. 11930002 * 11940002 L R0,VCLSTBLK GET TTR TO CATALOG LAST BLOCK 11950002 BAL BALREG2,TOABSL1 CONVERT 11960002 * 11970002 * SET UP CCW TO READ LAST KEY FIELD 11980002 * 11990002 LM R14,R15,ERCCWR GET RKD CCW 12000002 AR R14,R9 RELOCATE 12010002 STM R14,R15,OPTNCCW BUILD THE CHANNEL PROGRAM 12020002 * 12030002 * READ KEY FIELD AND 4 BYTES OF DATA OF THE LAST BLOCK OF CATALOG 12040002 * DATA SET. 12050002 * 12060002 BAL BALREG1,IO2 ***READ KEY FIELD*** 12070002 NC ERKEY,ERKEY KEY 0? 12080002 BNZ EXITCODE DO NOT CREATE ER 12090002 * 12100002 * CREATE THE ENVIRONMENT RECORD (SEE EREC FOR A DESCRIPTION) 12110002 * 12120002 * RELOCATE WRITE CCW 12130002 * 12140002 LM R14,R15,ERCCWW GET WRITE DATA CCW 12150002 AR R14,R9 RELOCATE FOR EREC1 12160002 STM R14,R15,OPTNCCW BUILD THE CHANNEL PROGRAM 12170002 * 12180002 * FIRST SAVE THE FIRST 20 BYTES OF EACH BUFFER 12190002 * 12200002 MVC ERINPUT,INENTRY SAVE 18 BYTES OF INPUT 12210002 MVC EROUTPUT,OUTENTRY SAVE 18 BYTES OF OUTPUT 12220002 LA R1,D01 12230002 A R1,EROCTR INCREMENT BY 1 12240002 ST R1,ERCTR SAVE IN NEW OUTPUT AREA 12250002 MVC ERMODMAP,MODMAP1 RELOCATE MOD MAP 12260002 MVC ERERRCOD,ERRCODE RELOCATE ERROR CODES 12270002 MVI ERNAME,CCDBLANK 12280002 MVC ERNAME+1(L'ERNAME-1),ERNAME BLANK NAME 12290002 LH R15,NAMLEN GET LENGTH OF NAME-1 12300002 L R14,CAMPTR1 GET PTR TO NAME 12310002 EX R15,MOVENAME MVC ERNAME(0),0(R14) 12320002 TIME DEC GET TIME AND DATE 12330002 STM R0,R1,ERTIME SAVE TIME AND DATE IN ER 12340002 * 12350002 * MOVE FLAGS INTO THE RECORD 12360002 * 12370002 MVC ERFLG12,ERFLAG12 FLAG1 AND FLAG2 12380002 MVC ERFLAG3,FLAG3 FLAG3 12390002 MVC ERNAMTTR,NAMTTR0 SAVE LEVEL NAME 12400002 MVC ERCAMLST,CAMLSTD SAVE OPTION BYTES 12410002 MVC ERWA1,ERTTRS SAVE TTRS 12420002 BAL BALREG1,IO2 WRITE ENVIRONMENT RECORD 12430002 B EXITCODE PREPARE AND RETURN TO CALLER 12440002 * 12450002 * 12460002 ERR2H EQU * 12470002 * 12480002 * AN ERROR FROM IGC0002H, TRANSLATE THE ERROR CODE TO @YL026UD 12490002 * THE PROPER CATALOG ERROR CODE 12500002 * 12510002 STC R1,ERRSV2H SAVE ERROR CODE 12520002 LA R7,ERROR28 INITIALLY ASSUME I/O ERROR 12530002 CLI ERRSV2H,ERROR12 12? 12540002 BE SETCODE BRANCH IF YES 12550002 * 12560002 LA R7,ERROR20 ASSUME NO SPACE ERROR 12570002 CLI ERRSV2H,ERROR08 8? 12580002 BE SETCODE BRANCH IF YES 12590002 * 12600002 LR R7,R1 MUST BE 4 OR 72 12610002 * 12620002 * SET SO SCHEDULER MOUNT MESSAGE IS NOT ISSUED 12630002 XC DEVTYPE,DEVTYPE 0 SWITCH 12640002 * 12650002 SETCODE EQU * 12660002 * 12670002 TM FLAG1,LOCATEF * LOCATE? 12680002 BZ SKIP1 BRANCH IF NO 12690002 STC R7,ERRLOCSV LOCATE ERROR 12700002 B EXITCODE SET PROPER CODE AND EXIT 12710002 * 12720002 SKIP1 EQU * 12730002 * 12740002 STC R7,ERRCATSV NON-LOCATE ERROR 12750002 * @OZ07699 12751037 EXITCODE EQU * @OZ07699 12758037 USING BLDLAREA,R13 BASE FOR MSGAREA @ZA05575 12765037 * ZA02665 12782037 * WRITE A MESSAGE TO THE OPERATOR IF THE ERROR CONDITION @ZA05908 12783037 * CALLS FOR IT @ZA05908 12784037 * ZA02665 12785037 TM FLAG1,LOCATEF LOCATE? @OZ12244 12785237 BO TSTSQERR YES, GOTO TSTSQERR @OZ12244 12785437 LA R13,BLDLAREA-WORKAREA(R6) ADDRESSABILITY @OZ12244 12785637 TSTSQERR EQU * 12785837 TM FLAG2,SEQERR DID CLC6 FIND SEQUENCE ZA02665 12786037 * ERROR ZA02665 12787037 BZ TSTENTRY NO,SKIP @ZA05908 12788037 MVC INPUT(MSG2LEN),MSG2 BUILD ERROR MESSAGE @ZA05908 12789037 * ROUTINE TO CONVERT TTR FROM HEX TO EBCDC FOR IEC304I MSG 12789137 UNPK CONWORK(7),CONWORK(4) TTR @OZ12193 12789237 NC CONWORK(7),MASK DROP ZONES @OZ12193 12789337 TR CONWORK(6),CONTABL SET TO EBCDIC @OZ12193 12789437 LA R1,INPUT+MSG2LEN-15 PT TO TTR OF MSG @OZ12193 12789537 MVC 0(6,R1),CONWORK MOVE TTR TO MSG @OZ12193 12789637 MVC INPUT+MSG2LEN+44(L'DESCRTE),DESCRTE MOVE IN @OZ14802 12789737 * ROUTE & DESCR CODES @OZ14802 12789837 LA 1,INPUT+MSG2LEN-7 SET BASE TO COMPLETE MSG 12790037 B BUILDMSG @ZA05908 12791037 TSTENTRY EQU * @ZA05908 12792037 TM FLAG2,ETYPERR CHK FOR ETYPE ERR @ZA05908 12792237 BZ TESTIO NO BR @ZA05908 12792437 MVC INPUT(MSG3LEN),MSG3 MOVE MSG TO WORKAREA @ZA05908 12792637 MVC INPUT+MSG3LEN+44(L'DESCRTE),DESCRTE MOVE IN @OZ14802 12792737 * ROUTE & DESCR CODES @OZ14802 12792837 LA 1,INPUT+MSG3LEN-7 SET TO COMPLETE MSG @ZA05908 12792937 B BUILDMSG @ZA05908 12793037 TESTIO EQU * ZA02665 12793137 * @OZ00006 12793337 * WRITE I/O ERROR MESSAGE TO OPERATOR IF THERE WAS AN I/O @OZ00006 12794337 * ERROR, SO HE CAN NOTIFY THE SYSTEMS PROGRAMMER @OZ00006 12794537 * @OZ00006 12794737 CLI ERRLOCSV,ERROR28 I/O ERROR ON LOCATE @OZ00006 12794937 BE WRITMSG YES, WRITE MSG @OZ00006 12795137 CLI ERRCATSV,ERROR28 I/O ERROR ON NON-LOCATE @OZ00006 12795237 BNE SETLEVLS NOT I/O ERROR, GO EXIT @OZ00006 12795537 WRITMSG EQU * @ZA05908 12795737 MVC INPUT(MSGLEN),MSG MESSAGE SKELETON @ZA02274 12795937 MVC INPUT+MSGLEN+44(L'DESCRTE),DESCRTE MOVE IN @OZ14802 12796037 * ROUTE & DESCR CODES @OZ14802 12796137 LA 1,INPUT+MSGLEN-7 @ZA05908 12796237 BUILDMSG EQU * @ZA05908 12796337 MVC 0(6,1),VOLSN VOL SER TO MSG @ZA05908 12796437 MVI 7(1),CCDBLANK BLANK NAME @ZA05908 12796637 MVC 8(L'ERNAME-1,1),7(1) @ZA05908 12796737 LH R15,NAMLEN NAME LENGTH @ZA05908 12796837 L R14,CAMPTR1 POINT TO NAME @ZA05908 12796937 EX R15,MOVENAM2 MOVE NAME TO MSG @ZA05908 12797037 LA R1,INPUT @ZA05908 12797637 WTO MF=(E,(1)) @ZA05908 12797837 DROP R13 @ZA05908 12798037 * @OZ00006 12798237 SETLEVLS EQU * @OZ00006 12798837 * 12799437 * SET PROPER ANALYSIS RETURN CODES @OZ07699 12800037 * 12810002 LH R10,NAMLF GET # OF LEVELS @OZ15062 12820008 XR R11,R11 CLEAR 12830002 IC R11,ERRLOCSV GET LOCATE ERROR CODE 12840002 XR R7,R7 CLEAR 12850002 IC R7,ERRCATSV INITIALLY ASSUME CATALOG ERROR 12860002 * 12862008 LTR R7,R7 CATALOG ERROR ? 12872008 BNZ FREERES BRANCH IF YES; RETURN THIS CODE 12882008 * 12892008 LTR R11,R11 LOCATE ERROR ? 12902008 BZ FREERES BRANCH IF NO; NO ERROR 12912008 * 12930002 LR R7,R11 SET LOCATE ERROR CODE 12940002 TM FLAG1,LOCATEF * LOCATE? 12950002 BO LOCODE BRANCH IF YES 12960002 * 12970002 CLI ERRLOCSV,ERROR04 LOCATE ERROR OF 4? 12980002 BE FREERES BRANCH IF YES 12990002 * 13000002 CLI ERRLOCSV,ERROR72 ERROR 72? 13010002 BE FREERES BRANCH IF YES; RETURN A 72 13020002 * 13030002 LA R7,ERROR08 13040002 CLI ERRLOCSV,ERROR28 LOCATE I/O ERROR? 13050002 BNE FREERES BRANCH IF NO; RETURN AN 8 13060002 * 13070002 LA R7,ERROR28 SET TO CATALOG I/O ERROR 13080002 B FREERES FREE RESOURCES 13090002 * 13100002 * 13110002 LOCODE EQU * 13120002 * 13130002 CLI ERRLOCSV,ERROR28 LOCATE I/O ERROR? 13140002 BNE FREERES BRANCH IF NO; RETURN THIS CODE 13150002 * 13160002 TM CAMOPTN1,CAMBLOCK LOCATE BY BLOCK? 13170002 BO DCBDEB BRANCH IF YES; RETURN A 28 13180002 * 13190002 LA R7,ERROR24 LOCATE I/O ERROR CODE IS 24 13200002 * 13210002 FREERES EQU * 13220002 * 13230002 TM CAMOPTN1,CAMBLOCK LOCATE BY BLOCK? 13240002 BO DCBDEB BRANCH IF YES--DO NOT ISSUE DEQ 13250002 * 13260002 TM FLAG2,ESTAEFL TESTFOR ESTAE FAILURE @ZA03161 13262037 BNZ DCBDEB BRANCH IF ESTAE FAILURE @YL026UD 13266002 * 13268002 * DEQUEUE VICE, VOLUME INDEX AND HIGH LEVEL NAME(RELEASE DEVICE), 13270002 * IF ENQUEUED UPON 13280002 * 13290002 XC ENQRNAM8,ENQRNAM8 SET RNAME FOR VICE 13300002 * 13310002 * SET FLAG TO HAVE IN CASE NO PREVIOUS ENQ 13320002 * 13330002 OI ENQFLAGS,HAVE 13340002 DEQ ,MF=(E,(R5)) DEQ VICE 13350002 * 13360002 NI ENQFLAGS,SMCSTEPC NO 'RESET MUST CMPLT' Y01965 13370002 MVC ENQRNAM8,ENQNAME SET RNAME FOR VOLUME INDEX 13380002 DEQ ,MF=(E,(R5)) DEQ VOLUME INDEX 13390002 * 13400002 MVI ENQFLAGS,RESERVE+HAVE TURN ON RESERVE @ZA04613 13410037 MVC ENQRNAM8,HILVLNAM SET RNAME FOR HIGH LEVEL 13420002 * 13430002 * DEQUE NAME AND RELEASE ('UN-RESERVE') THE DEVICE 13440002 * 13450002 DEQ ,MF=(E,(R5)) DEQ NAME 13460002 * 13470002 * 13480002 DCBDEB EQU * 13490002 * 13500002 * FREE THE MAIN STORAGE FOR THE DCB/DEB AREA 13510002 * 13520002 TM FLAG1,FREEDCB DCB/DEB ALREADY FREED? 13530002 BO RPSTST BRANCH IF YES; CHECK FOR RPS WA 13540002 * 13550002 * GET DCB/DEB ADDRESS FREE 13560002 L R1,DCBADDR 13570002 * IF CLC3 HAS GOTTEN CONTROL DCBADDR IS NO LONGER VALID 13580002 TM MODMAP1,MODCLC3 HAS CLC3 GOTTEN CONTROL? 13590002 BZ SKIP5 BRANCH IF NO 13600002 L R1,IOBDCB GET DCB ADDRESS FROM IOB 13610002 * 13620002 SKIP5 EQU * 13630002 * 13640002 * IF R1=0 THEN THE DCB/DEB GETMAIN HAS NOT BEEN ISSUED YET 13650002 * 13660002 LTR R1,R1 0? 13670002 BZ FREEWA BRANCH IF YES 13680002 * FREE THE DCB/DEB AND CLOSE THE CATALOG 13690002 USING DCBAREA,R1 13700002 L R0,NMBYTES GET LENGTH 13710002 LA R1,DCBAREA GET ADDRESS @YL026UD 13720002 XC SVOPNWAP(4),SVOPNWAP RESET WKA PTR (ESTAE) @YL026UD 13722002 SVC FREEMAIN FREEMAIN R,LV=(0),A=(1) 13730002 DROP R1 13740002 * 13750002 * 13760002 RPSTST EQU * 13770002 * 13780002 TM FLAG2,RPSDEV RPS WA? 13790002 BZ FREEWA BRANCH IF NO 13800002 * 13810002 * FREE RPS WORKAREA 13820002 * 13830002 LA R0,RPSEND-RPSD GET LENGTH 13840002 L R1,RPSAVEP GET ADDRESS OF THE AREA 13850002 XC SVRPSWAP(4),SVRPSWAP RESET WKA PTR (ESTAE) @YL026UD 13852002 SVC FREEMAIN FREEMAIN R,LV=(0),A=(1) 13860002 * 13870002 * 13880002 FREEWA EQU * 13890002 * 13900002 * FREE WORKAREA 13910002 * 13920002 * INITIALLY ASSUME NON-LOCATE FUNCTION 13930002 * 13940002 L R12,CWAP RESTORE CONTROLLER WA PTR Y01113 13950002 LA R0,WORKEND-WORKAREA GET LENGTH OF AREA TO FREE 13960002 LR R1,R6 GET POINTER TO AREA TO FREE 13970002 * 13980002 TM FLAG1,LOCATEF * LOCATE? 13990002 BZ FREEWA2 BRANCH IF NO 14000002 * 14010002 TM FLAG1,RTNBLK RETURN BLK TO USER? 14020002 BZ SKIP6 BRANCH IF NO 14030002 * 14040002 USING BLDLAREA,R13 ESTABL ADDRBLTY TO 'BLDLAREA' 14050002 MVC RETDATA,BLDLBUFF RETURN BLK 14060002 DROP R13 14070002 * 14080002 * 14090002 SKIP6 EQU * 14100002 * 14110002 LR R1,R13 GET POINTER TO AREA TO FREE 14130002 LA R0,BLDLEND-BLDLAREA GET LENGTH TO FREEMAIN @YL026UD 14134002 * 14140002 FREEWA2 EQU * 14150002 * 14160002 SVC FREEMAIN FREEMAIN R,LV=(0),A=(1) 14170002 * 14180002 * RETURN TO INTERFACE MAPPER (IGG0CLCA OR IGG0CLCB) @YL026UD 14242002 * @YL026UD 14244002 ESTAE 0 RESET ESTAE EXIT @YL026UD 14244402 * @YL026UD 14244502 * PUT RETURN CODES INTO PROPER REGISTERS AND EXIT @YL026UD 14244802 * @YL026UD 14245202 LR R0,R10 NUMBER OF LEVELS FOUND @YL026UD 14245602 LR R1,R11 INDIC RETURN & CODE @YL026UD 14245702 ICM R1,8,HEX8 INDCATE CVOL VS VSAMCAT @OZ32432 14245837 LR R15,R7 SET RETURN CODE @YL026UD 14246237 * @YL026UD 14246637 L R13,612(R12) GET CIII SAVEAREA PTR @YL026UD 14247037 LM R2,R12,28(R13) RESTORE REGISTERS 2-12 @YL026UD 14248002 L R14,12(R13) RESTORE RETURN REGISTER @YL026UD 14248102 BR R14 RETURN TO IGG0CLCA/CLCB @YL026UD 14248402 EJECT 14250002 * 14260002 **************** 14270002 * * 14280002 READ EQU * 14290002 * * 14300002 **************** 14310002 * 14320002 BAL BALREG2,TOABSL1 GO TO CONVERT 14330002 MVC OPTNCCW,RD MOVE IN READ DATA CCW 14340002 BAL BALREG1,IO2 ***READ DATA*** 14350002 MVI OPTNCCW,WDOP MOVE IN WRITE DATA OP-CODE 14360002 BR BALREG4 RETURN 14370002 * 14380002 EJECT 14390002 * 14400002 **************** 14410002 * * 14420002 WRITE EQU * 14430002 * * 14440002 **************** 14450002 * 14460002 BAL BALREG1,IO2 ***WRITE DATA*** 14470002 * 14480002 * VERIFY THE WRITE OPERATION 14490002 * 14500002 MVC OPTNCCW,RKD MOVE IN CCW--NO TRANSFER 14510002 BAL BALREG1,IO2 ***READ KEY & DATA*** 14520002 BR BALREG4 RETURN 14530002 * 14540002 EJECT 14550002 * 14560002 **************** 14570002 * * 14580002 TOABSL1 EQU * 14590002 * * 14600002 **************** 14610002 * 14620002 * FUNCTION: 14630002 * CONVERT THE TTR0 IN R0 TO AN ABSOLUTE DASD ADDRESS AND 14640002 * PUT IT INTO THE IOB MBBCCHHR 14650002 * 14660002 * INPUT: 14670002 * R0 IS THE TTR0 TO BE CONVERTED 14680002 * RETURN ADDRESS IN BALREG2 14690002 * 14700002 * OUTPUT: 14710002 * ABSOLUTE DASD ADDRESS IN IOB 14720002 * ERROR CODE IN R15 14730002 * 14740002 * DESTROYED: 14750002 * REGISTERS - R0,R1,R2,R14, AND R15=0 14760002 * WA - SAVEAREA AND MBBCCHHR OF THE IOB 14770002 * 14780002 * SUBROUTINES USED: 14790002 * THE RESIDENT CONVERT ROUTINE - IECPCNVT 14800002 * 14810002 * 14820002 **************** 14830002 **************** 14840002 * 14850002 L R15,EPTOABSL GET CONVERT ADDRESS FROM WA 14860002 B CONVERT1 USE COMMON CODE 14870002 EJECT 14880002 * 14890002 **************** 14900002 * * 14910002 TORLTV1 EQU * 14920002 * * 14930002 **************** 14940002 * 14950002 * FUNCTION: 14960002 * MOVE THE DASD ADDRESS OF CCHHR FROM NXTCNT INTO THE CCHHR OF THE 14970002 * IOB. THIS GIVES THE TTR OF THE NEXT FREE BLOCK. 14980002 * 14990002 * INPUT: 15000002 * RETURN IN BALREG2 15010002 * UPDATED NXTCNT 15020002 * 15030002 * OUTPUT: 15040002 * TTR0 IN R0 15050002 * 15060002 * DESTROYED: 15070002 * REGISTERS -- R0,R1,R2,R14, AND R15=0 15080002 * WA -- SAVEAREA AND CCHHR OF IOB 15090002 * 15100002 * SUBROUTINES USED: 15110002 * THE RESIDENT CONVERT ROUTINE -- IECPRLTV 15120002 * 15130002 * 15140002 **************** 15150002 **************** 15160002 * 15170002 MVC IOBSKADD+3(L'NXTCCHHR),NXTCCHHR MOVE COUNT FIELD 15180002 * 15190002 L R15,EPTORLTV GET ADDRESS OF ROUTINE FROM WA 15200002 * 15210002 * 15220002 CONVERT1 EQU * 15230002 * 15240002 * THE FOLLOWING SECTION IS COMMON TO BOTH ROUTINES 15250002 * 15260002 STM R9,R13,SAVEAREA SAVE REGS DESTROYED BY CONVERT 15270002 L R1,DEBADDR GET DEB ADDRESS 15280002 LA R2,IOBSKADD POINT TO MBBCCHHR 15290002 BALR BALREG1,R15 GO TO CONVERT ROUTINE 15300002 LM R9,R13,SAVEAREA RESTORE REGISTERS 15310002 BR BALREG2 RETURN TO CALLER 15320002 EJECT 15330002 * 15340002 *** 15350002 **************** 15360002 * * 15370002 IO2 EQU * 15380002 * * 15390002 **************** 15400002 * 15410002 * FUNCTION: 15420002 * 1. IF THE DEVICE HAS THE RPS FEATURE, THE SET SECTOR CCW IS 15430002 * UPDATED. 15440002 * 2. ISSUE EXCP FOR THE CHANNEL PROGRAM POINTED TO BY THE IOB. 15450002 * 3. WAIT FOR THE OPERATION TO COMPLETE AND CHECK THE ECB. 15460002 * 4. IF AN END OF EXTENT CONDITION, BRANCH TO IGC0002H @YL026UD 15470002 * AND EXTEND THE CATALOG. @YL026UD 15480002 * 5. IF A PERMANENT I/O ERROR, SET AN ERROR CODE AND BRANCH TO 15490002 * ERREXIT. 15500002 * 15510002 * INPUT: 15520002 * UPDATED CHANNEL PROGRAM 15530002 * RETURN ADDRESS IN BALREG 1 15540002 * 15550002 * OUTPUT: 15560002 * 1. FILLED BUFFER OR 15570002 * 2. EMPTIED BUFFER OR 15580002 * 3. ANOTHER FREE BLOCK ADDRESS 15590002 * 15600002 * DESTROYED: 15610002 * REGISTERS R0,R1,R15 (IF EXTENDS) 15620002 * 15630002 * EXTERNAL ROUTINES USED: 15640002 * EXCP, WAIT, IGC0002H TO EXTEND CATALOG @YL026UD 15650002 * 15660002 * EXITS: 15670002 * IGC0002H TO EXTEND THE CATALOG @YL026UD 15680002 * IGG0CLC7 FOR PERMANENT I/O ERROR 15690002 **************** 15700002 **************** 15710002 * 15720002 USING RPSD,R1 15730002 * 15740002 TM FLAG2,RPSDEV RPS FEATURE? 15750002 BZ EXCP2 BRANCH IF NO 15760002 L R1,RPSAVEP GET RPS SAVE AREA PTR 15770002 STM R9,R2,RPSAVE SAVE REGS DESTROYED BY CONVERT 15780002 LM R15,R2,RPSINPUT GET SECTOR CONVERT INPUT PARAMS 15790037 IC R0,IOBSKADD+7 GET R OF CCHHR 15800037 BALR R14,R15 CONVERT R TO SECTOR 15810037 LM R9,R2,RPSAVE RESTORE REGISTERS 15820002 * 15830002 * 15840002 EXCP2 EQU * 15850002 * 15860002 EXCP IOB ISSUE EXCP 15870002 WAIT ECB=ECB WAIT FOR REQUEST 15880002 CLI ECB,X7F I/O ERROR? 15890002 BCR 8,BALREG1 BRANCH IF NO 15900002 NC ERRCODE,ERRCODE PROCESSING ER? 15910002 BNZ EXITCODE BRANCH IF YES--IGNORE ERROR 15920002 CLI ECB,X'42' OUT OF EXTENT? 15930002 BE EXTEND2 BRANCH IF YES AND EXTEND 15940002 MVI ERRCATSV,ERROR28 SET ERROR CODE TO I/O ERROR 15950002 B ERREXIT EXIT 15960002 * 15970002 EXTEND2 EQU * 15980002 * 15990002 * EXTEND CATALOG 16000002 * 16010002 ST BALREG1,SVBALREG SAVE CURRENT BALREG1 @YL026UD 16012002 L R0,IOBDCB GET DCB PTR 16020002 L R15,IGC0002H @OZ00006 16022002 BALR BALREG1,R15 GO TO NEXT EXTENT @OZ00006 16030002 * 16032002 L BALREG1,SVBALREG RESTORE SAVED BALREG1 @YL026UD 16034002 LTR R1,R15 CHECK RETURN CODE 16040002 BZ EXCP2 RE-ISSUE REQUEST IF OK 16050002 * SA52094 16060002 * UNABLE TO EXTEND CATALOG, BUT THIS REQUEST HAS SA52094 16070002 * COMPLETED NORMALLY SO EXIT SA52094 16080002 * SA52094 16090002 B EXITCODE EXIT SA52094 16100002 * 16110002 DROP R1 16120002 TITLE 'IGG0CLCE - CONSTANT DEFINITIONS' @YL026UD 29090002 * 29100002 * CONSTANTS @YL026UD 29110002 * 29120002 USING EREC,R9 @YL026UD 29120402 DS 0F 29122002 ERCCWR EQU * 29124002 DC X'0E' READ KEY AND DATA 29126002 DC AL3(ERKEY-EREC) POINT TO BUFFER 29128002 DC X'2000' SLI 29128402 DC H'12' READ 12 BYTES 29128802 DS 0F 29129202 ERCCWW EQU * 29129602 DC X'05' WRITE DATA 29129702 DC AL3(0) BUFFER PTR SET DURING EXECUTION 29129802 TTRVFST DS 0XL3 TTR OF THE FIRST BLOCK OF VI 29129902 DC X'0000' ALL FLAGS OFF 29133202 DC H'256' BYTES WRITTEN 29135202 * 29135602 ONEREC DC F'256' UP TTR0 BY ONE 29136002 MOVE1 MVC 0(0,OUT),0(IN) 29136402 MSG DC AL2(MSGLEN+44),X'8000' @OZ14802 29136837 DC C'IEC302I SYSCTLG I/O ERROR,VVVVVV,' @OZ00006 29137002 MSGLEN EQU *-MSG LENGTH OF MSG SKELETON @OZ00006 29137102 DESCRTE DC X'10004040' SYSTEM STATUS,SYSTEM @OZ00006 29137202 * ERROR/MAINTENANCE, @OZ00006 29137402 * MASTER CONSOLE INFOR- @OZ00006 29138002 * MATIONAL @OZ00006 29138202 DS 0H @OZ00006 29138402 MOVENAM2 MVC 7(0,1),0(R14) OBJECT OF EXECUTE @ZA02274 @ZA05908 29138637 MOVENAME MVC ERNAME(0),0(R14) 29138802 MSG2 DC AL2(MSG2LEN+44),X'8000' @OZ14802 29139037 DC C'IEC304I SYSCTLG ENTRY SEQUENCE ERROR,X''TTTTRR'',VVVVV*29139137 V,' SEQUENCE ERROR MESSAGE @OZ12193 29139237 MSG2LEN EQU *-MSG2 ZA02665 29139337 MSG3 DC AL2(MSG3LEN+44),X'8000' @OZ14802 29139437 DC C'IEC305I INVALID ENTRY IN SYSCTLG,VVVVVV,' @ZA05908 29139737 MSG3LEN EQU *-MSG3 @ZA05908 29140737 DROP R9 YL026UD 29141737 * 29142737 HICCHHNT DC X'7FFF7FFF7FFF' HIGH CCHH COUNT. 29219602 IGC0002H DC V(IGC0002H) @OZ00006 29219702 EXTMAXCC DC F'2' MAXIMUM EXTEND RETURN CODE @YL026UD 29223202 CONTABL DC CL16'0123456789ABCDEF' TRANSLATE TABLE @OZ12193 29223837 MASK DC X'0F0F0F0F0F0F00' HEX TO EBCDC MASK @OZ12193 29224437 HEX8 DC X'08' ONE BYTE CONSTANT 08 @OZ32432 29225237 TITLE 'IGG0CLCE - CHANNEL COMMAND WORD DEFINITIONS' 29225602 * 29226002 * PATTERN CHANNEL COMMAND WORDS. 29226702 * 29230002 CCW1 CCW X'31',M2B2C2HR+3-AREADCB,X'40',5 SEARCH EQUAL ID@YL026UD 29232002 CCW2 CCW X'08',CHPG-AREADCB,0,1 TIC TO CCW1 @YL026UD 29234002 CCW3 CCW X'06',IECSDSF4-AREADCB,X'60',48 READ VTOC DSCB. @YL026UD 29236002 CCW4 CCW X'D1',DS4HPCHR-AREADCB,X'40',5 SEARCH HI ID. @YL026UD 29238002 CCW5 CCW X'08',CHPG+48-AREADCB,0,1 TIC TO CCW7. @YL026UD 29238402 CCW6 CCW X'03',0,0,1 CONTROL NOP. 29238802 CCW7 CCW X'29',DS1DSNAM-AREADCB,X'60',44 SEARCH KEY EQUAL@YL026UD 29239202 CCW8 CCW X'08',CHPG+24-AREADCB,0,1 TIC TO CCW4. @YL026UD 29239602 CCW9 CCW X'06',DS1FMTID-AREADCB,X'40',96 RD SYSCTLG DSCB @YL026UD 29239702 CCW10 CCW X'12',COUNT-AREADCB,0,8 READ COUNT. @YL026UD 29239802 CCWRDKD CCW X'0E',DSCBK-AREADCB,0,140 READ KEY & DATA @YL026UD 29239902 * 29243202 CCWSID CCW X'31',MBBCCHHR+3-WKAREA,X'40',5 SEARCH ID 29246702 DC X'0800000000000000' TIC 29250002 CCWWR CCW X'1D',COUNT2-CHPGA2,X'60',8 WRITE CKD, SLI 29260002 CCWRCH CCW X'1E',0,X'50',272 READ CKD, SKIP 29270002 READVTOC CCW X'29',D1SDSNAM-WKAREA,X'60',44 SEARCH KEY EQUAL 29280002 CCW X'08',CHPGA-WKAREA,0,1 TIC 29290002 CCW X'06',D1SFMTID-WKAREA,0,96 READ DATA 29300002 WRVTOC CCW X'05',D1SFMTID-WKAREA,X'40',96 WRITE DATA 29310002 CCW X'29',D1SDSNAM-WKAREA,X'60',44 SEARCH KEY EQUAL 29320002 CCW X'08',CHPGA4-WKAREA,0,1 TIC 29330002 CCW X'06',0,X'10',96 CHECK DATA 29340002 CCWRD CCW X'06',BLOCK-WKAREA,X'00',256 READ DATA SA50973 29350002 CCWWDOP EQU X'05' WRITE DATA OP CODE SA50973 29360002 CCWOPTN1 EQU X'30' NO TRANSFER, SILI SA50973 29370002 CCWOPTN2 EQU X'40' COMMAND CHAIN SA50973 29380002 * @YL026UD 29382002 * @YL026UD 29384002 * MODULE PATCH AREA (MAINTENANCE AREA) @YL026UD 29386002 * @YL026UD 29388002 DS 0H 29388437 FIXAREA DC 100C'Z' @YL026UD 29388537 * @YL026UD 29388802 TITLE 'IGG0CLCE - CONSTANT EQUATE DEFINITIONS' 29390002 * 29392002 * CONSTANT EQUATES 29394002 * 29396002 VICETYP EQU 5 VICE TYPE CODE 29398002 ICETYP EQU 3 ICE TYPE CODE 29398402 ILETYP EQU 0 ILE TYPE CODE 29398802 IPETYP EQU 0 IPE TYPE CODE 29399202 DSPETYP EQU 7 OR MORE, FOR DSPE TYPE CODE 29399602 VCBPETYP EQU 1 VCBPE TYPE CODE 29399702 OCVOLTYP EQU 3 OLD CVOL TYPE CODE 29399802 NCVOLTYP EQU 5 NEW CVOL TYPE CODE 29399902 ALIASTYP EQU 4 ALIAS TYPE CODE 29403202 GIPETYP EQU 2 GIPE TYPE CODE 29405202 ERROR00 EQU 0 29405602 ERROR04 EQU 4 29406002 ERROR08 EQU 8 29406402 ERROR12 EQU 12 29406502 ERROR16 EQU 16 29406602 ERROR20 EQU 20 29407702 ERROR24 EQU 24 29408102 ERROR28 EQU 28 29408502 ERROR32 EQU 32 29408602 ERROR72 EQU 72 29408702 *********************************************************************** 29408802 * CHARACTER CODE DEPENDENT CONSTANTS 29411602 *********************************************************************** 29413602 CCDBLANK EQU C' ' 29414002 CCDRPARN EQU C')' 29414102 CCDMINUS EQU C'-' 29414202 CCDPLUS EQU C'+' 29414302 CCD0 EQU C'0' 29415202 CCDG EQU C'G' 29415602 CCDV EQU C'V' 29416002 CCDPERD EQU C'.' 29416102 CCDLPARN EQU C'(' 29416202 *********************************************************************** 29417102 * 29418202 * MISCELLANEOUS EQUATES USED . 29419102 * 29420002 ONE EQU 1 A ONE CONSTANT. 29440002 TWO EQU 2 A TWO CONSTANT. 29450002 THREE EQU 3 A THREE CONSTANT. 29460002 FOUR EQU 4 A FOUR CONSTANT. 29470002 EIGHT EQU 8 AN EIGHT CONSTANT. 29480002 TEN EQU 10 A TEN CONSTANT. 29490002 TWELVE EQU 12 A TWELVE CONSTANT. 29492002 NINTY EQU 90 DSCB MOVE LENGTH. 29494002 B12 EQU 12 BINARY 12 29500002 B14 EQU 14 BINARY 14 29510002 B15 EQU 15 BINARY 15. 29520002 B22 EQU 22 BINARY 22 29530002 B24 EQU 24 BINARY 24 29540002 B26 EQU 26 BINARY 26 29550002 B36 EQU 36 BINARY 36 29560002 B40 EQU 40 BINARY 40 EQUATE. 29570002 B100 EQU 100 BINARY 100 29580002 B105 EQU 105 BINARY 105 29590002 B184 EQU 184 BINARY 184 29592002 B253 EQU 253 SUBPOOL 253 CONSTANT. 29594002 RPSIDLOC EQU 62 OFFSET TO RPS ID XM2100 29600002 X00 EQU X'00' HEX 00 29610002 X01 EQU X'01' HEX 01 29612002 X0D EQU X'0D' HEX 0D 29620002 X0E EQU X'0E' HEX 0E 29630002 X10 EQU X'10' HEX 10 29632002 X12 EQU X'12' HEX 12 29640002 X14 EQU X'14' HEX 14 29650002 X18 EQU X'18' HEX 18 29652002 X20 EQU X'20' HEX 20 29660002 X42 EQU X'42' HEX 42 29662002 X7F EQU X'7F' HEX 7F 29664002 X81 EQU X'81' HEX 81 29666002 XBF EQU X'BF' HEX BF 29670002 XFF EQU X'FF' HEX FF 29680002 X100 EQU X'100' HEX 100 29690002 X105 EQU X'105' HEX 105 29700002 X0100 EQU X'0100' HEX 0100 29704002 DEBAD EQU 44 DEB POINTER IN DCB 29720002 WASZ EQU 128 SIZE OF RPS WORK AREA. 29730002 AVTSV EQU 120 DISP TO AVT PTR IN RPSWA. 29740002 DEBAPDS EQU 28 APPNDG. PTR DISP. IN DEB. 29750002 FMWAL EQU 512 FORMAT WORKAREA LENGTH. 29752002 * 29754002 CODPERD EQU 4 29756002 CODBLANK EQU 8 29758002 CODPARN EQU 12 29758402 CLC1 EQU C'1' 29758802 CLC2 EQU C'2' 29759202 CLC3 EQU C'3' 29759602 CLC4 EQU C'4' 29759702 CLC5 EQU C'5' 29759802 CLC6 EQU C'6' 29759902 CLC7 EQU C'7' 29763202 FREEMAIN EQU 10 29765202 * 29765602 CC EQU X'40' COMMAND CHAIN 29766002 SLACK EQU 32 MAXIMUM NUMBER OF UNUSED BYTES 29766402 * ALLOWED IN A CATALOG INDEX BLOCK 29766502 SILI EQU X'20' SUPPRESS INCORRECT LENGTH 29766602 * 29769902 D01 EQU 1 29772002 D12 EQU 12 29772402 D16 EQU 16 29772802 TITLE 'IGG0CLCE - REGISTER EQUATE DEFINITIONS' 29773202 * 29776702 * THE FOLLOWING ARE REGISTER EQUATES USED IN THIS PROGRAM. 29780002 * 29790002 R0 EQU 0 REGISTER 0 29800002 R1 EQU 1 REGISTER 1 29810002 R2 EQU 2 REGISTER 2 29820002 R3 EQU 3 REGISTER 3 29830002 R4 EQU 4 REGISTER 4 29840002 R5 EQU 5 REGISTER 5 29850002 R6 EQU 6 REGISTER 6 29860002 R7 EQU 7 REGISTER 7 29870002 R8 EQU 8 REGISTER 8 29880002 R9 EQU 9 REGISTER 9 29890002 R10 EQU 10 REGISTER 10 29900002 R11 EQU 11 REGISTER 11 29910002 R12 EQU 12 REGISTER 12 29920002 R13 EQU 13 REGISTER 13 29930002 R14 EQU 14 REGISTER 14 29940002 R15 EQU 15 REGISTER 15 29950002 RGA EQU 2 REGISTER 2 29960002 RGB EQU 3 REGISTER 3 29970002 RGC EQU 4 REGISTER 4 29980002 RGD EQU 5 REGISTER 5 29990002 RGE EQU 6 REGISTER 6 30000002 RGF EQU 7 REGISTER 7 30010002 RGG EQU 8 REGISTER 8 30020002 RGH EQU 9 REGISTER 9 30030002 RGBASE EQU 4 BASE REGISTER @YL026UD 30032002 RGDQTY EQU 10 DIRECTORY QUANTITY 30040002 RGTTR EQU 11 RELATIVE TRACK COUNTER 30050002 RGAREA EQU 13 WORK AREA ADDRESS 30070002 RGRET EQU 14 RETURN REGISTER 30080002 * 30082002 BALREG1 EQU R14 30084002 BALREG2 EQU R12 30086002 BASE EQU R4 30088002 * 30088402 BALREG3 EQU R11 30088802 BALREG4 EQU R3 30089202 * 30089602 IN EQU R9 30089702 OUT EQU R7 30089802 LENGTH EQU R5 30089902 NEXTTTR EQU R10 30093202 * 30095202 RFKEY EQU 0 INPUT FUNCTION REQUEST KEY. 30095602 RPARM EQU 1 INPUT PARAMETER REGISTER. 30096002 RBASE EQU 4 BASE REGISTER. @YL026UD 30096502 RCWA EQU 6 CATALOG WORK AREA BASE. 30096602 RGAREA2 EQU 8 SECONDARY DCB BASE REGISTER. 30099902 RGAREA3 EQU 9 TERTIARY DCB BASE REGISTER. 30102002 RFKEYA EQU 10 POSSIBLE TTR KEY FROM EXTEND. 30102402 RUCB EQU 11 UCB BASE REGISTER. 30102802 RBR EQU 15 RETURN CODE REGISTER. 30103202 * 30103302 SPACE 30103402 * 30106702 ********************************************************************** 30110002 * 30120002 * END OF THE IGG0CLCE CSECT. 30130002 * 30140002 FMTSIZE EQU * EQUATE TO LAST BYTE OF CSECT. 30150002 MAXSIZE EQU IGG0CLCE+X'1000' MAXIMUM ALLOWABLE LENGTH. 30160002 AVAILABL EQU MAXSIZE-FMTSIZE FREE SPACE REMAINING. 30170002 * 30180002 ********************************************************************** 30190002 * 30200002 TITLE 'IGG0CLCE - CATALOG WORKAREA DSECT' 30210002 * 30212002 * DSECTS 30214002 * 30216002 WORKAREA LIST=YES 30218037 TITLE 'IGG0CLCE - ENVIRONMENT RECORD DSECT' 30218402 EREC DSECT ENVIRONMENT RECORD 30218802 ERCTR DS F RESERVED 30219202 ERES1 DS 1F RESERVED 30219602 ERTIME DS 2F TIME AND DATE 30219702 ERCAMLST DS 1F CAMLST OPTION BYTES 30219802 ERMODMAP DS XL1 MODULE MAP 30219902 ERFLG12 DS XL2 FLAG1 AND FLAG2 30223202 ERFLAG3 DS XL1 FLAG3 30225202 ERERRCOD DS XL2 CATALOG AND LOCATE ERROR CODES 30225602 ERNAMTTR DS XL14 CURRENT LEVEL NAME 30226002 EREGSAV DS 15F REGS 1 THROUGH 14 30226402 ERWA1 DS XL28 TTRS IN WORKAREA 30226502 ORG ERWA1 OVERLAY 12 BYTES 'ERWA1' SA52063 30226602 ERKEY DS CL8 KEY FIELD SA52063 30227702 EROCTR DS CL4 OLD COUNT SA52063 30228102 ORG 30228502 ERINPUT DS XL18 FIRST 18 BYTES OF 'INPUT' 30228602 EROUTPUT DS XL18 FIRST 18 BYTES OF 'OUTPUT' 30228702 EROPTNCC DS XL8 'OPTNCCW'--INDICATES LAST I/O 30228802 ERIOB DS XL40 IOB 30231602 ERNAME DS CL44 FULL GIVEN NAME 30233602 ERBUFF EQU ERWA1 READ BUFFER 30234002 TITLE 'IGG0CLCE - FORMAT WORKAREA DSECT' 30234102 * 30234402 * THIS DSECT DEFINES THE WORK AREA PASSED TO THE FORMAT ROUTINE. 30237202 * 30240002 SPACE 30250002 WKAREA DSECT 30260002 FSVAREA DS 0F REG SAVE AREA. 30270002 SVBLKS DS F NUMBER OF BLOCKS FOR DIRECTORY 30280002 SVDCB DS F DCB ADDRESS 30290002 SVBLPTK DS F NUMBER OF BLOCKS PER TRACK 30300002 SVBYTES DS F NUMBER OF BYTES IN WORK AREA 30310002 SVADDR DS F ADDRESS OF WORK AREA 30320002 SVCNT DS F DATA MANAGEMENT COUNT 30330002 SVTT DS F STARTING RELATIVE TRACK ADDRESS 30340002 CHPGA DS 0D WRITE CHANNEL PROGRAM 30350002 CHPGA1 DS D CCW 1. 30360002 CHPGA2 DS D CCW 2. 30370002 CHPGA3 DS D CCW 3. 30380002 CHPGA4 DS D CCW 4. 30390002 CHPGA5 DS D CCW 5. 30400002 CHPGA6 DS D CCW 6. 30410002 CHPGA7 DS D CCW 7. 30420002 CHPGA8 DS D CCW 8. 30430002 CHPGA9 DS D CCW 9. 30440002 CHPGA10 DS D CCW 10. 30450002 CHPGA11 DS D CCW 11. 30460002 CHPGA12 DS D CCW 12. 30470002 CHPGA13 DS D CCW 13. 30480002 CHPGA14 DS D CCW 14. 30490002 CHPGA15 DS D CCW 15. 30500002 CHPGA16 DS D CCW 16. 30510002 CHPGA17 DS D CCW 17. 30520002 CHPGB DS 0D READ CHANNEL PROGRAM 30530002 CHPGB1 DS D CCW 1. 30540002 CHPGB2 DS D CCW 2. 30550002 CHPGB3 DS D CCW 3. 30560002 CHPGB4 DS D CCW 4. 30570002 CHPGB5 DS D CCW 5. 30580002 CHPGB6 DS D CCW 6. 30590002 CHPGB7 DS D CCW 7. 30600002 CHPGB8 DS D CCW 8. 30610002 CHPGB9 DS D CCW 9. 30620002 CHPGB10 DS D CCW 10. 30630002 CHPGB11 DS D CCW 11. 30640002 CHPGB12 DS D CCW 12. 30650002 CHPGB13 DS D CCW 13. 30660002 CHPGB14 DS D CCW 14. 30670002 CHPGB15 DS D CCW 15. 30680002 CHPGB16 DS D CCW 16. 30690002 CHPGB17 DS D CCW 17. 30700002 EJECT 30710002 ORG CHPGA6 OVERLAY CHPGA AND B SA50973 30720002 BLOCK DS 0CL256 BUFFER SA50973 30730002 DS XL2 FILLER, 'BYTES USED' SA50973 30740002 DS XL12 FILLER, FRST PART 'VICE' SA50973 30750002 UPLSTBLK DS XL2 FRST 2 BYTES 'VCLSTBLK' SA50973 30760002 ORG 30770002 COUNT2 DS 0D DIRECTORY CONTROL BLOCK 30780002 CTKEY DS CL8 KEY OF DIR BLOCK. 30790002 CTCOUNT DS CL2 COUNT OF DIRECTORY BLOCK. 30800002 CTDIR DS CL7 FILLER. 30810002 CTLBK DS CL1 LOW ORDER OF NAME. 30820002 DS CL2 FILLER. 30830002 CTTTRC DS CL2 TTRC 30840002 CTHITT DS CL2 HI TT. 30850002 CTHIR DS CL1 HI R. 30860002 DS CL3 FILLER. 30870002 CTNABTR DS CL1 NEXT AVAILABLE BLOCK TTR. 30880002 DS CL2 FILLER. 30890002 CTNBLB DS CL1 BYTES IN LAST BLOCK. 30900002 CTHIENT DS CL8 HI ENTRY. 30910002 DS CL72 FILLER. 30920002 HICOUNT DS D LAST RELATIVE TRACK 30930002 FECB DS F EVENT CONTROL BLOCK 30940002 FIOB DS 8F INPUT OUTPUT BLOCK 30950002 MBBCCHHR DS CL8 SEEK ADDRESS 30960002 BPAMDIR DS 0X BDAM DIRECTORY 30970002 BPDCNT DS CL8 BPAM DIR COUNT. 30980002 BPDHIK DS CL9 BPAM DIR HI KEY. 30990002 BPDBPB DS CL1 BPAM DIR BYTES PER BLOCK. 31000002 BPDHIE DS CL8 BPAM DIR HI ENTRY. 31010002 ORG COUNT2-148 ORG EXTEND SAVE AREA. 31020002 EXTSAVE DS CL8 FIRST EXTENT OF DEB 31030002 * 31040002 * FORMAT 1 DSCB 31042002 * 31044002 D1SDSNAM DS CL44 DATA SET NAME 31046002 D1SFMTID DS CL1 FORMAT IDENTIFIER 31048002 D1SDSSN DS CL6 DATA SET SERIAL NUMBER 31048402 D1SVOLSQ DS XL2 VOLUME SEQUENCE NUMBER 31048802 D1SCREDT DS XL3 CREATION DATE 31049202 D1SEXPDT DS XL3 EXPIRATION DATE 31049602 D1SNOEPV DS XL1 NUMBER OF EXTENTS ON VOLUME 31049702 D1SNOBDB DS XL1 NUMBER OF BYTES USED IN LAST 31049802 * DIRECTORY BLOCK 31049902 DS XL1 RESERVED 31053202 D1SSYSCD DS CL13 SYSTEM CODE 31055202 DS XL7 RESERVED 31057202 D1SDSORG DS XL2 DATA SET ORGANIZATION 31059202 D1SRECFM DS XL1 RECORD FORMAT 31059602 D1SOPTCD DS XL1 OPTION CODE 31059702 D1SBLKL DS XL2 BLOCK LENGTH 31059802 D1SLRECL DS XL2 RECORD LENGTH 31059902 D1SKEYL DS XL1 KEY LENGTH 31063202 D1SRKP DS XL2 RELATIVE KEY POSITION 31065202 D1SDSIND DS XL1 DATA SET INDICATORS 31067202 D1SSCALO DS XL4 SECONDARY ALLOCATION 31069202 D1SLSTAR DS XL3 LAST USED TRACK AND BLOCK 31069602 D1STRBAL DS XL2 BYTES REMAINING ON LAST TRACK 31069802 DS XL2 RESERVED 31069902 D1SEXT1 DS XL10 FIRST EXTENT DESCRIPTION 31073202 * FIRST BYTE EXTENT TYPE INDICATOR 31075202 * SECOND BYTE EXTENT SEQUENCE NUMBER 31077202 * THIRD - SIXTH BYTES LOWER LIMIT 31079202 * SEVENTH - TENTH BYTES UPPER LIMIT 31079602 D1SEXT2 DS XL10 SECOND EXTENT DESCRIPTION 31079702 D1SEXT3 DS XL10 THIRD EXTENT DESCRIPTION 31079802 D1SPTRDS DS XL5 POSSIBLE POINTER TO A FORMAT 31079902 * 2 OR 3 DSCB 31083202 D1SEND EQU * 31085202 TITLE 'IGG0CLCE - COMMUNICATION VECTOR TABLE DSECT' 31090002 * 31340002 *COMMUNICATION VECTOR TABLE DEFINITION 31400002 * 31410002 TITLE 'IGG0CLCE - DCB/DEB AREA DSECT' 31440002 * 31450002 * THIS DSECT DESCRIBES THE DCB/DEB AREA. 31460002 * 31470002 AREADCB DSECT 31480002 DS 6F DCB AREA FILLER. 31490002 DAREA DS 0F WORK AREA REFERENCE. 31500002 NUMBYTES DS F NUMBER OF BYTES. 31510002 DSCBTRK DS F CC HH OF SYSCTLG DSCB. 31520002 CATWKAP DS 1F CATALOG WORKAREA ADDRESS @YL026UD 31530002 BLDLP DS 1F BLDL WORKAREA ADDRESS @YL026UD 31540002 DEB DS 0F START OF THE DEB. 31550002 DEBTCBAD DS F TCB ADDRESS. 31560002 DEBAMIND DS 0X AM INDICATOR. 31570002 DEBDEBAD DS F NEXT DEB ADDRESS. 31580002 DS 2F IRB AND SYS PURGE CHAIN. 31590002 DEBNMEXT DS 0X NO OF EXTENTS. 31600002 DS 2F USER PURGE AND PURGE ECB ADDR. 31610002 DEBDCBAD DS F DCB ADDRESS. 31620002 DEBAPPAD DS F APPENDAGE VECTOR TABLE ADDRESS. 31630002 DEBDVMOD DS 0X DEBICE MODIFIER MASK. 31640002 DEBUCBAD DS F UCB ADDRESS. 31650002 DEBBINUM DS H BIN NUMBER. 31660002 DEBSTRCH DS 0CL8 START/END CCHH. 31670002 DEBSTRCC DS H START CYLINDER. 31680002 DEBSTRHH DS H START HEAD. 31690002 DEBENDCC DS H END CYLINDER. 31700002 DEBENDHH DS H END HEAD. 31710002 DEBNMTRK DS H NUMBER OF TRACKS. 31720002 EXTL EQU 16 LENGTH OF AN EXTENT ENTRY. 31730002 MAXEL EQU 256 MAXIMUM EXTENT AREA LENGTH. 31740002 DEBEND EQU * 31750002 DEBL EQU DEBEND-DEB DEB LENGTH. 31760002 EJECT 31770002 * 31780002 * FORMAT 4 DSCB DEFINITION. 31790002 * 31800002 SPACE 31810002 IECSDSL1 (4) 31820002 ORG IECSDSF4+48 ORG TO CCW AREA. 31830002 CHPG DS 2D CHANNEL PROGRAM RELOCATE AREA. 31840002 CHPGAA DS 2D CHANNEL PROGRAM RELOCATE AREA. 31850002 CHPGBB DS 2D CHANNEL PROGRAM RELOCATE AREA 31860002 CHPGCC DS 2D CHANNEL PROGRAM RELOCATE AREA 31870002 CHPGDD DS 2D CHANNEL PROGRAM RELOCATE AREA 31880002 AECB DS F EVENT CONTROL BLOCK. 31890002 AIOB DS 8F I/O CONTROL BLOCK. 31900002 M2B2C2HR DS CL8 SEEK ADDRESS IN THE IOB. 31910002 CCHHR EQU M2B2C2HR+3 CHANNEL-HEAD ADDRESS. 31920002 CCHHRL EQU 5 LENGTH OF CCHHR. 31930002 DSCBK DS CL44 DATA SET NAME AREA. 31940002 DSCBK4 EQU DSCBK+4 FOUR BYTES OFF DSCBK 31950002 DSCBD EQU DSCBK+44 FOURTY FOUR BYTES OFF DSCBK 31960002 * 31970002 * FORMAT 1 DSCB DEFINITION. 31980002 * 31990002 SPACE 32000002 ORG DSCBK ORG COUNT AREA. 32010002 IECSDSL1 (1) 32020002 COUNT DS CL8 SYSCTLG DSCB DISK ADDR/ 32030002 COUNTA EQU COUNT+4 32040002 * WORKAREA FOR CONVERT ROUTINE. 32050002 REGSAVE DS 1F REGISTER SAVE AREA 32060002 REGS2 DS 1F REGISTER SAVE AREA. 32070002 REGS3 DS 1F REGISTER SAVE AREA 32080002 REGS4 DS 1F REGISTER SAVE AREA. 32090002 REGS5 DS 1F REGISTER SAVE AREA. 32100002 REGS6 DS 1F REGISTER SAVE AREA. 32110002 NUMUCB DS H NUMBER OF UCB'S. 32120002 SWL EQU 6 LENGTH OF SWITCH AREA. 32130002 FMTSW DS X COUNT OF BLOCK TRACK. 32140002 EXTDSW DS X EXTEND COUNTER. 32150002 EXTDTT DS F RELATIVE TRACK ADDRESS. 32160002 AREAEND2 DS 0D USED TO DETERMINE NUMBER BYTES. 32170002 EXTDRGSV DS 2F REGISTER SAVE AREA. 32180002 * 32190002 * EXTEND WORK AREA DEFINITION. 32200002 * 32210002 ORG DAREA ORG TO EXTEND AREA. 32220002 EXTDAREA DS 0F 32230002 IECDSECT 32240002 TITLE 'IGG0CLCE - UNIT CONTROL BLOCK DSECT' 32250002 * 32260002 * THIS IS THE UCB DEFINITION DSECT. 32270002 * 32280002 SPACE 32290002 UCB DSECT 32300002 IEFUCBOB 32310002 END IGG0CLCE 32320002