CRE TITLE 'DMTCRE (RSCS) VM/370 - RELEASE 6' 00001000 *. 00002000 * MODULE NAME - 00003000 * 00004000 * DMTCRE 00005000 * 00006000 * FUNCTION - 00007000 * 00008000 * CREATE NEW TASKS UNDER MSUP 00009000 * 00010000 * ATTRIBUTES - 00011000 * 00012000 * REUSABLE 00013000 * 00014000 * ENTRY POINTS - 00015000 * 00016000 * DMTCRE - CREATE A TASK 00017000 * DMTCREDA - LOAD DASD I/O TABLE 00018000 * 00019000 * ENTRY CONDITIONS - 00020000 * 00021000 * DMTCRE MAY BE CALLED FROM ROUTINES WITHIN THE REX TASK 00022000 * 00023000 * GPR0 = CHAR COUNT OF PARM STRING FOR NEW TASK 00024000 * GPR1 = ADDR OF PARAMETER STRING FOR NEW TASK 00025000 * GPR2 = ADDR OF LINK TABLE ENTRY DESCRIBING THE 00026000 * TASK TO BE CREATED 00027000 * GPR14 = RETURN ADDRESS 00028000 * GPR15 = ENTRY ADDRESS 00029000 * 00030000 * EXIT CONDITIONS - 00031000 * 00032000 * NORMAL - 00033000 * 00034000 * R15 RETURN CODE = 0 00035000 * 00036000 * ERROR - 00037000 * 00038000 * R15 RETURN CODES: 00039000 * 00040000 * 1 => INVALID LOAD DATA FORMAT 00041000 * 2 => REQUIRED STORAGE UNAVAILABLE 00042000 * 3 => TASK NAME DUPLICATE 00043000 * 4 => MAX NUMBER OF TASK ACTIVE 00044000 * 5 => NO SUPQUEUE ELEMENT AVAILABLE 00045000 * 6 => UNEXPECTED EOF 00046000 * 7 => FILE NOT FOUND 00047000 * 8 => FILE FORMAT ERROR (A LA CMS) 00048000 * 9 => FATAL I/O ERROR 00049000 * 00050000 EJECT 00051000 * 00052000 * CALLS TO OTHER ROUTINES - 00053000 * 00054000 * DMTASK - TO CREATE A TASK IN MSUP 00055000 * 00056000 * EXTERNAL REFERENCES - 00057000 * 00058000 * NONE 00059000 * 00060000 * TABLES / WORKAREAS - 00061000 * 00062000 * DMTVEC - COMMON SUPERVISOR AREA 00063000 * DMTSYS - RSCS SYSTEM CONTROL COMMON AREA 00064000 * LINK TABLE 00065000 * 00066000 * (ALL VARIABLES AND BUFFERS USED BY THE CMS READ 00067000 * ACCESS METHOD ARE ORGANIZED IN A SINGLE AREA TO 00068000 * FACILITATE MAINTENANCE AND DEVELOPMENT.) 00069000 * 00070000 * REGISTER USAGE - 00071000 * 00072000 * ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00073000 * ANY INDIVIDUAL DEVIATIONS OR EXTENSIONS ARE LISTED WITH THE 00074000 * COMMAND DESCRIPTION 00075000 * 00076000 * GPR0 = (NON-ADDRESS) CALLING PARAMETER 00077000 * GPR1 = CALLING PARAMETER 00078000 * GPR2 = SCRATCH 00079000 * GPR3 = SCRATCH 00080000 * GPR4 = SCRATCH 00081000 * GPR5 = SCRATCH 00082000 * GPR6 = SCRATCH 00083000 * GPR7 = SCRATCH 00084000 * GPR8 = UNUSED 00085000 * GPR9 = LINK TABLE ADDRESS 00086000 * GPR10 = UNUSED 00087000 * GPR11 = UNUSED 00088000 * GPR12 = BASE REGISTER 00089000 * GPR13 = UNUSED 00090000 * GPR14 = LINKAGE REG - RETURN ADDRESS 00091000 * GPR15 = LINKAGE REG - ENTRY ADDRESS AND RETURN CODE 00092000 * 00093000 * NOTES - 00094000 * 00095000 * DMTCRE IS GENERALLY USED TO CREATE LINE DRIVER TASKS 00096000 * DURING LINK ACTIVATION, BUT IT IS ALSO USED TO CREATE 00097000 * THE AXS AND LAX TASKS DURING RSCS INITIALIZATION. 00098000 * 00099000 * OPERATION - 00100000 * 00101000 * THE MAIN LINE OF THE DMTCRE ROUTINE INCLUDES TWO 00102000 * PHASES, EXECUTED SEQUENTIALLY, ONCE FOR EACH CALL. 00103000 * DMTCRE FIRST LOADS AND RELOCATES A PROGRAM INTO 00104000 * VIRTUAL STORAGE, AND THEN CAUSES IT TO BE EXECUTED 00105000 * AS A NEW TASK THROUGH SUPERVISOR CALLS. A CMS READ 00106000 * ACCESS METHOD IS INCLUDED IN THIS MODULE, AND IS USED 00107000 * BY THE LOADER FOR READING CMS TEXT FILES. THE CMS 00108000 * ACCESS METHOD IS DESCRIBED BELOW. 00109000 * 00110000 *. 00111000 EJECT 00112000 DMTCRE CSECT 00113000 ENTRY DMTCREDA 00114000 USING DMTCRE,R15 GET TEMP ADDRESSABILITY 00115000 STM R0,R15,CRESAVE SAVE CALLER'S REGISTERS TO BE USED 00116000 LA R12,0(R15) GET THE RIGHT ADDRESSABILITY 00117000 DROP R15 00118000 USING DMTCRE,R12 GET THE STANDARD ADDRESSABILITY 00119000 USING SVECTORS,0 GET SVECTORS ADDRESSABILITY 00120000 LR R9,R2 GET THE LINKTABL ADDR 00121000 USING LINKTABL,R9 GET LINKTABL ADDRESSABILITY 00122000 XC CRESTORE(8),CRESTORE CLEAR MAIN STORAGE GOTTEN FIELDS 00123000 SPACE 00124000 MVC OPENFILE(8),LACTDRVR MOVE IN THE FILENAME 00125000 MVC OPENFILE+8(8),CREFTYPE AND THE FILETYPE 00126000 BAL R14,CMSOPEN FIND AND INITIALIZE THE REQUESTED FILE 00127000 LTR R15,R15 DID THAT WORK OUT? 00128000 BNZ CRETERM NOPE - QUIT WITH A RETURN CODE 00129000 SPACE 00130000 CRESDREC EQU * 00131000 BAL R14,CMSGET GET THE NEXT FILE RECORD 00132000 LTR R15,R15 DID WE GET IT? 00133000 BNZ CRETERM NOPE - GIVE UP WITH ERROR CODE 00134000 CLC 0(4,R1),ESDCODE IS THIS AN ESD RECORD? 00135000 BNE CRESDREC NOPE - INVALID RECORD - TRY AGAIN 00136000 SR R2,R2 CLEAR R2 FOR INSERT 00137000 IC R2,11(R1) R2=NUMBER OF BYTES OF ESD DATA 00138000 SRL R2,4 R2=NUMBER OF SEPARATE ESD SUBRECORDS 00139000 LTR R2,R2 ARE THERE ANY AT ALL? 00140000 BNP CRESDREC NOPE - TRY TO GET ANOTHER ESD RECORD 00141000 CRESDGET EQU * 00142000 LA R1,16(R1) R1=ADDRESS OF NEXT ESD SUBRECORD 00143000 CLI 8(R1),X'00' IS THIS A CSECT ENTRY? 00144000 BE CRESDGOT YEP - GO INITIALIZE FOR TEXT READ 00145000 BCT R2,CRESDGET KEEP CYCLING THROUGH ESD RECORD 00146000 B CRESDREC TRY TO GET ANOTHER WHEN EXHAUSTED 00147000 SPACE 00148000 CREMOVE MVC OPENFILE(0),LACTDRVR TO BE EXECUTED BY ABOVE CODE 00149000 EJECT 00150000 CRESDGOT EQU * 00151000 MVI CRESTART,X'00' ZERO TOP BYTE OF START ADDRESS FIELD 00152000 MVC CRESTART+1(3),9(R1) MOVE IN CSECT START ADDRESS 00153000 MVI CRELEN,X'00' CLEAR HIGH ORDER BYTE OF LENGTH FIELD 00154000 MVC CRELEN+1(3),13(R1) MOVE IN THE CSECT LENGTH FROM ESD 00155000 L R2,CRELEN R2=LENGTH OF CSECT TO BE LOADED IN BYTES 00156000 LTR R2,R2 IS THERE ANY LENGTH? 00157000 BNP CREFOUL NOPE - CAN'T DO MUCH WITH THIS FILE 00158000 AL R2,CRESAVE R2=TOTAL LENGTH NEEDED INCLUDING PARM 00159000 SRL R2,12 R2=NUMBER OF PAGES NEEDED - 1 00160000 SPACE 00161000 CREMAIN EQU * 00162000 L R3,MAINMAP R3=ADDRESS OF MAIN STORAGE MAP 00163000 LR R4,R3 R4=MAP ADDRESS TOO 00164000 AL R3,MAINSIZE R3=ADDRESS OF END OF MAIN STORAGE MAP 00165000 SLR R3,2 R3=MAP SCAN STARTING POINT + 1 00166000 BCTR R3,0 BUMP R3 BACK TO EXACT MAP SCAN STARTING POINT 00167000 CREMNEXT EQU * 00168000 CLR R3,R4 HAVE WE BACKED UP TO THE START OF THE MAP YET? 00169000 BNH CREFULL YEP - NO STORAGE AVAILABLE - TOO BAD 00170000 EX R2,CRESCAN CHECK FOR AVAILABLE STORAGE HERE 00171000 BZ CRETRYIT FOUND SOME - TRY TO GET IT CLAIMED 00172000 BCT R3,CREMNEXT KEEP SCANNING TABLE FOR AVAILABLE STORAGE 00173000 B CREFULL SHOULDN'T BE HERE - PUNT WITH NO STORAGE CODE 00174000 SPACE 00175000 CRESCAN OC 0(0,R3),0(R3) TO BE EXECUTED BY CODE ABOVE 00176000 EJECT 00177000 CRETRYIT EQU * 00178000 LA R0,1(R2) R0=NUMBER OF PAGES TO BE REQUESTED 00179000 SLR R3,4 R3=REQUESTED STARTING PAGE NUMBER 00180000 LR R1,R3 R1=REQUESTED PAGE NUMBER FOR CALL TO SUPMAIN 00181000 L R15,MAINREQ R15=ENTRY ADDRESS FOR MAIN STORAGE REQ 00182000 BALR R14,R15 CALL MAIN STORAGE HANDLER TO GET STORAGE 00183000 LTR R15,R15 DID WE GET THE PAGES? 00184000 BNZ CREMAIN NOPE - START TABLE SCAN ALL OVER AGAIN 00185000 SPACE 00186000 STM R0,R1,CRESTORE SET GOTTEN STORAGE CONTROL FIELD 00187000 SLL R1,12 R1=ADDRESS OF FIRST PAGE OF GOTTEN STORAGE 00188000 ST R1,CRELOAD INITIALIZE LOAD START CONTROL FIELD 00189000 LR R2,R1 R2=STARTING ADDRESS FOR LOAD ALSO 00190000 SL R2,CRESTART R2=ACTUAL RELOCATION FACTOR FOR LOAD 00191000 SLL R0,12 R0=TOTAL AVAILABLE STORAGE FOR LOAD 00192000 ALR R1,R0 R1=ADDR OF END OF AVAILABLE STORAGE 00193000 ST R1,CRELIMIT STORE END OF STORAGE ADDRESS IN CONTROL 00194000 SPACE 00195000 CRENEXTX EQU * 00196000 BAL R14,CMSGET GET THE NEXT RECORD FROM THE FILE 00197000 LTR R15,R15 DID WE GET ANOTHER ONE? 00198000 BNZ CREFOUL NOPE - RETURN WITH ACCESS CODE 00199000 CLC 0(4,R1),TXTCODE IS THIS RECORD A TEXT RECORD? 00200000 BNE CRECHKTX CHECK IT CAREFULLY IF IT ISN'T 00201000 SR R4,R4 CLEAR R4 FOR INSERT 00202000 ST R4,CREADDR CLEAR ADDRESS JUSTIFICATION FIELD 00203000 ICM R4,B'0001',11(R1) R4=NUMBER OF BYTES OF TEXT DATA H 00204000 BNP CRENEXTX NOPE - TRY ANOTHER RECORD 00205000 MVC CREADDR+1(3),5(R1) MOVE TEXT DATA ADDRESS TO CONTROL 00206000 L R3,CREADDR R3=UNRELOCATED TEXT ADDRESS 00207000 ALR R3,R2 R3=RELOCATED TEXT DATA LOAD ADDRESS 00208000 CL R3,CRELOAD IS IT ABOVE THE LOWER LIMIT? 00209000 BL CREFOUL BAD FORMAT IF IT IS 00210000 LA R5,0(R3,R4) R5=END OF RELOCATED TEXT DATA LOAD 00211000 CL R5,CRELIMIT IS IT BELOW THE UPPER LIMIT? 00212000 BH CREFOUL BAD FORMAT AGAIN 00213000 BCTR R4,0 BUMP BYTE COUNT DOWN FOR CHAR OP PECULIARITY 00214000 EX R4,CRETLOAD MOVE THE TEXT DATA TO RELOCATED ADDRESS 00215000 B CRENEXTX KEEP LOADING TEXT RECORDS 00216000 SPACE 00217000 CRETLOAD MVC 0(0,R3),16(R1) TO BE EXECUTED TO LOAD SOME TEXT DATA 00218000 EJECT 00219000 CRECHKTX EQU * 00220000 CLC 0(4,R1),ENDCODE DID WE HIT AN END CARD? 00221000 BE CRETASK YEP - NO RELOCATION TO DO - MAKE A TASK 00222000 CLC 0(4,R1),RLDCODE DID WE HIT AN RLD RECORD? 00223000 BNE CRENEXTX NOPE - MUST BE AN INVALID RECORD - IGNORE IT 00224000 SPACE 00225000 CRELOCAT EQU * 00226000 SR R4,R4 CLEAR R4 FOR INSERT 00227000 IC R4,11(R1) R4=NUMBER OF BYTES OF RLD DATA 00228000 LA R4,16(R4,R1) R4=END OF RLD DATA FOR THIS RECORD 00229000 LA R1,20(R1) INITIALIZE RLD SUBRECORD POINTER TO FIRST 00230000 CRENEXRL EQU * 00231000 CLR R1,R4 HAVE WE PASSED THE END OF THE RLD DATA ON THIS REC 00232000 BNL CRERLDRD YES - GO TRY TO READ ANOTHER RECORD 00233000 TM 0(R1),X'F2' ANY FUNNY STUFF IN THE FLAG FIELD? 00234000 BNZ CREFOUL CAN'T HANDLE PR'S, BRANCH TYPES, NEG RELOCATES 00235000 SR R5,R5 CLEAR R5 FOR INSERT 00236000 IC R5,0(R1) R5=RLD FLAG FIELD 00237000 SRL R5,2 R5=LENGTH OF RELOCATABLE ADCON - 1 00238000 LTR R5,R5 IS THERE ANY LENGTH? 00239000 BNP CREFOUL NOPE - BAD FORMAT 00240000 LA R5,1(R5) R5=ACTUAL LENGTH OF RELOCATABLE ADCON 00241000 LA R6,CREADDR+4 R6=ADDR OF END OF JUSTIFICATION FIELD 00242000 SLR R6,R5 R6=ADDRESS FOR JUSTIFICATION MOVE 00243000 MVI CREADDR,X'00' BUT FIRST, MUST RELOCATE ADCON ADDRESS 00244000 MVC CREADDR+1(3),1(R1) MOVE IN UNRELOCATED ADCON ADDRESS 00245000 L R3,CREADDR R3=UNRELOCATED ADCON ADDRESS 00246000 ALR R3,R2 R3=RELOCATED ADCON ADDRESS 00247000 CL R3,CRELOAD IS THE ADCON ABOVE THE LOWER LIMIT? 00248000 BL CREFOUL BAD FORMAT IF NOT 00249000 LA R7,0(R5,R3) R7=RELOCATED ADDR OF END OF ADCON 00250000 CL R7,CRELIMIT IS IT BELOW THE UPPER LIMIT? 00251000 BH CREFOUL BAD FORMAT AGAIN IF NOT 00252000 XC CREADDR(4),CREADDR CLEAR JUSTIFICATION FIELD 00253000 BCTR R5,0 BUMP DOWN ADCON CHAR COUNT FOR MOVE 00254000 EX R5,CREADGET MOVE UNRELOCATED ADCON TO FULLWORD 00255000 L R7,CREADDR R7=UNRELOCATED ADCON 00256000 ALR R7,R2 RELOCATE THE ADCON, AND ... 00257000 ST R7,CREADDR RESTORE THE RELOCATED ADCON TO FULLWORD 00258000 EX R5,CREADPUT MOVE THE RELOCATED ADCON BACK TO STORAGE 00259000 TM 0(R1),X'01' CHECK FLAG FIELD FOR FOLLOWING SUBREC FORMAT 00260000 LA R1,4(R1) MOVE SUBRECORD POINTER AHEAD TO NEXT 00261000 BO CRENEXRL AND DO THE RELOCATE IF IT'S WHERE WE WANT IT 00262000 LA R1,4(R1) MOVE AHEAD FOUR MORE PAST R & P POINTERS 00263000 B CRENEXRL AND DO THE RELOCATE 00264000 SPACE 00265000 CREADGET MVC 0(0,R6),0(R3) MOVE ADCON TO JUSTIFICATION FIELD (EXECUTE 00266000 CREADPUT MVC 0(0,R3),0(R6) MOVE ADCON BACK AGAIN (EXECUTED ABOVE) 00267000 EJECT 00268000 CRERLDRD EQU * 00269000 BAL R14,CMSGET GET ANOTHER RECORD FROM THE FILE 00270000 LTR R15,R15 DID WE GET ANOTHER? 00271000 BNZ CRETERM NOPE - CLEAN UP AND QUIT WITH RETURN CODE 00272000 CLC 0(4,R1),RLDCODE IS THIS ANOTHER RLD RECORD? 00273000 BE CRELOCAT YEP - GO PROCESS IT FROM THE TOP 00274000 B CRETASK GO TURN LOADED RELOCATED FILE INTO A TASK 00275000 EJECT 00276000 CRETASK EQU * 00277000 LM R0,R1,CRESAVE RESTORE PARM FIELD DESCRIPTOR REGISTERS 00278000 L R2,CRELOAD R2=RELOCATED ADDRESS OF START OF LOAD 00279000 ST R0,TGREG0-TAREA(R2) INITIALIZE PARM CHAR COUNT REGISTER 00280000 LTR R3,R0 IS THERE ANY PARM FIELD SPECIFIED? 00281000 BNP CREQTASK NOPE - FORGET ABOUT MOVING IT AROUND 00282000 LR R4,R2 R4=ADDRESS OF START OF LOAD TOO 00283000 AL R4,CRELEN R4=RELOCATED ADDR OF END OF CSECT 00284000 BCTR R3,0 BUMP PARM CHAR COUNT DOWN FOR EXECUTE OF MOVE 00285000 EX R3,CRESETUP MOVE THE PARAMETER FIELD TO TASK STORAGE 00286000 ST R4,TGREG1-TAREA(R2) INITIALIZE PARM FIELD POINTER REGIST 00287000 CREQTASK EQU * 00288000 ST R9,TGREG2-TAREA(R2) GIVE THE TASK HIS LINK TABLE ADDR 00289000 L R0,LACTTNME R0=STANDARD FORMAT NAME FOR LOADED TASK 00290000 L R1,CRELOAD R1=ADDRESS OF NEW TASK SYS S/A 00291000 L R15,TASKREQ R15=ADDRESS OF TASK MANAGER ENTRY POINT 00292000 BALR R14,R15 REQUEST NEW TASK WITH NAME=CURRENT SEQUENCE NU 00293000 LTR R15,R15 DID IT WORK O.K.? 00294000 BNZ CRENOTSK NOPE - GO SEE WHY NOT 00295000 LM R2,R3,CRESTORE PICK UP GOTTEN CORE INFO 00296000 L R1,MAINMAP R1=ADDRESS OF MAIN STORAGE MAP 00297000 ALR R1,R3 R1=START OF NEW TASK STORAGE ENTRY 00298000 STC R0,0(R1) SET NEW TASK ID IN THE STORAGE TABLE 00299000 BCTR R2,0 BUMP NUMBER OF PAGES DOWN ONE 00300000 LTR R2,R2 WERE THERE MORE THAN ONE? 00301000 BNP CREFINIS NOPE - CLEAR RETURN CODE AND RETURN 00302000 BCTR R2,0 BUMP DOWN ONE MORE FOR CHAR OP 00303000 EX R2,CREPROP SET ENTIRE STORAGE TABLE ENTRY TO NEW TASK ID 00304000 CREFINIS EQU * 00305000 SR R15,R15 AND CLEAR REPLY ADDRESS RETURN REGISTER 00306000 CREXIT EQU * 00307000 LM R0,R14,CRESAVE RESTORE REGS 00308000 BR R14 AND RETURN TO THE CALLER 00309000 SPACE 00310000 CRESETUP MVC 0(0,R4),0(R1) MOVE PARM FIELD TO NEW TASK (EXECUTED ABOV 00311000 CREPROP MVC 1(0,R1),0(R1) PROPAGATE NEW ID IN STORAGE TABLE (EXECUTE 00312000 EJECT 00313000 CREFOUL EQU * 00314000 LA R15,X'01' SET RETURN CODE TO INVALID LOAD DATA FORM 00315000 B CRETERM CLEAN UP AND RETURN TO CALLER 00316000 SPACE 00317000 CREFULL EQU * 00318000 LA R15,X'02' SET RETURN CODE STORAGE UNAVAILABLE 00319000 B CRETERM CLEAN UP AND RETURN TO CALLER 00320000 SPACE 00321000 CRENOTSK EQU * 00322000 LR R2,R15 SAVE DMTASK RETURN CODE 00323000 LA R15,3 SET DUP NAME 00324000 SRA R2,3 SEE IF RC = 3 00325000 BZ CRETERM YES..ALL DONE 00326000 LA R15,5 SET NO SUP QUEUE ELEMENT 00327000 BCT R2,CRETERM TAKE RETURN 00328000 LA R15,4 SET MAX TASKS RETURN 00329000 CRETERM EQU * 00330000 LM R2,R3,CRESTORE PICK UP GOTTEN STORAGE INFORMATION 00331000 LTR R2,R2 DID WE GET ANY STORAGE SO FAR? 00332000 BZ CREXIT DON'T WANT TO FREE ANY IF NOT 00333000 L R1,MAINMAP R1=ADDRESS OF START OF MAIN STORAGE MAP 00334000 ALR R1,R3 R1=ADDRESS OF START OF GOTTEN ENTRY 00335000 BCTR R2,0 BUMP COUNT DOWN ONE FOR CHAR OP 00336000 EX R2,CREFREE FREE THE UNUSED GOTTEN CORE 00337000 B CREXIT AND RETURN TO CALLER WITH CODE AS IT STANDS 00338000 SPACE 00339000 CREFREE XC 0(0,R1),0(R1) CLEAR MAIN STORAGE TABLE ENTRY (EXECUTED) 00340000 EJECT 00341000 *---------------------------------------------------------------------* 00342000 * * 00343000 * TASK CREATION CONTROL AREA * 00344000 * * 00345000 *---------------------------------------------------------------------* 00346000 SPACE 00347000 CREWORK DC D'0' DOUBLEWORD USED FOR DECIMAL CONVERSION 00348000 SPACE 00349000 CREFTYPE DC 0F'0',CL8'TEXT' INITIAL OPEN FILE TYPE 00350000 SPACE 00351000 ESDCODE DC X'02',CL3'ESD' FIRST FOUR CHARACTERS OF AN ESD RECORD 00352000 TXTCODE DC X'02',CL3'TXT' FIRST FOUR CHARACTERS OF A TXT RECORD 00353000 RLDCODE DC X'02',CL3'RLD' FIRST FOUR CHARACTERS OF AN RLD RECORD 00354000 ENDCODE DC X'02',CL3'END' FIRST FOUR CHARACTERS OF AN END RECORD 00355000 SPACE 00356000 CRESTORE DC 2F'0' COUNT AND START NUMBER OF GOTTEN PAGES 00357000 SPACE 00358000 CRELOAD DC A(0) (RELOCATED) LOWER LOAD LIMIT ADDRESS 00359000 CRELIMIT DC A(0) (RELOCATED) UPPER LOAD LIMIT ADDRESS 00360000 CRESTART DC A(0) (UNRELOCATED) LOAD CSECT START ADDRESS 00361000 CRELEN DC A(0) LOAD CSECT LENGTH 00362000 CREADDR DC A(0) FIELD FOR JUSTIFYING ADDRESSES FOR RELOCATION 00363000 SPACE 00364000 CRESAVE DC 16F'0' REGISTER SAVE AREA FOR USE BY CREATE ROUTINE 00365000 EJECT 00366000 *. 00367000 * 00368000 * ENTRY NAME - 00369000 * 00370000 * CMSFILCH 00371000 * 00372000 * FUNCTION - 00373000 * 00374000 * READ ONE DASD BLOCK FROM A CMS DISK 00375000 * 00376000 * CALLS TO OTHER ROUTINES - 00377000 * 00378000 * NONE 00379000 * 00380000 * OPERATION - 00381000 * 00382000 * THE CMS BLOCK NUMBER IS TRANSLATED TO BBCCHHR DASD 00383000 * ADDRESS FORMAT, DEPENDING ON THE DASD DEVICE TYPE, 00384000 * AND THE DASD I/O READ OPERATION TO READ THE BLOCK 00385000 * IS PERFORMED. 00386000 * 00387000 * ENTRY CONDITIONS - 00388000 * 00389000 * THE DASD I/O ACCESS TABLES MUST BE PROPERLY SET TO 00390000 * REFLECT THE DASD DEVICE TYPE. 00391000 * 00392000 * GPR1 = CMS BLOCK NUMBER OF BLOCK TO BE READ (BINARY) 00393000 * 00394000 * RESPONSES - 00395000 * 00396000 * NONE 00397000 * 00398000 * ERROR MESSAGES - 00399000 * 00400000 * NONE 00401000 * 00402000 *. 00403000 SPACE 00404000 SPACE 00405000 CMSFILCH DC 0H'0' 00406000 STM R14,R5,CFILSAVE SAVE REGISTERS TO BE MODIFIED 00407000 SR R3,R3 CLEAR OUT R3 00408000 ICM R3,B'0011',CFILSAVE+14 AND GET R1 BLOCK NUM 00409000 SR R2,R2 CLEAR R2 FOR DIVIDE AND CLEAR OF BIN ADDR FIEL 00410000 BCTR R3,0 BUMP BLOCK NUMBER DOWN ONE 00411000 D R2,PERCYL CALC CYLINDER ADDR 00412000 ST R3,BBCCHHR SET 00CC IN DISK ADDR 00413000 LR R3,R2 REMAINDER TO DIVIDE AGAIN 00414000 SR R2,R2 CLEAR FOR NEXT DIVIDE 00415000 D R2,PERTRACK CALC TRACK AND REC ADDRS 00416000 LA R2,1(R2) NORMALIZE TO RECORD 1 00417000 ICM R4,B'1111',OVERNUM ANY OVERFLOW HERE? 00418000 BZ CFILASIS NO NEED TO ADJUST TRACK ADDR 00419000 AR R3,R3 DOUBLE TRACK ADDR TO REAL ... 00420000 CR R2,R4 RECORD ON SECOND OF PAIR? 00421000 BNH CFILASIS NO - CORRECT AS IS 00422000 LA R3,1(R3) INCREMENT TO CORRECT TRACK 00423000 CFILASIS EQU * 00424000 STH R3,BBCCHHR+4 SET TRACK ADDR IN HH 00425000 STC R2,BBCCHHR+6 AND REC NUM IN R 00426000 CLI DEVCODE-IOTABLE+DASD,TYP2314 2314 DASD? 00427000 BE CFILDOIO YES - ALL DONE 00428000 MVI DASETSEC,X'23' SET SECTOR COMMAND CODE 00429000 LA R2,DASDSECS(R2) ADDR OF RECS SECTOR BYTE 00430000 MVC SECTOR(1),0(R2) SET THE SECTOR NUMBER 00431000 SPACE 00432000 CFILDOIO EQU * 00433000 XC DASD(4),DASD CLEAR DIRECT ACCESS I/O SYNCH LOCK 00434000 LA R1,DASD R1=ADDRESS OF DASD I/O TABLE 00435000 L R15,IOREQ R15=ENTRY ADDRESS FOR SUP I/O REQUEST 00436000 BALR R14,R15 START THE DISK I/O 00437000 L R15,WAITREQ R15=ADDRESS OF SUP WAIT REQUEST ENTRY 00438000 BALR R14,R15 WAIT FOR I/O COMPLETION SIGNAL 00439000 SPACE 00440000 SR R15,R15 CLEAR RETURN CODE FOR NOW 00441000 CLI DASD+SIOCOND-IOTABLE,X'00' DID THE I/O START PROPERLY? 00442000 BNE CFILERR SIGNAL I/O ERROR TO CALLER IF NOT 00443000 TM DASD+ENDCSW-IOTABLE+4,X'FF'-CUE-CE-DE DEV STAT @VA04030 00444500 BNZ CFILERR ERROR IF ANYTHING ELSE 00445000 CLI DASD+ENDCSW-IOTABLE+5,X'00' ANY CHANNEL STATUS SET? 00446000 BNE CFILERR BAD SITUATION IF SO 00447000 CFILEXIT EQU * 00448000 L R14,CFILSAVE RESTORE REUTRN ADDRESS 00449000 LM R0,R5,CFILSAVE+8 RESTORE THE REST OF THE REGS 00450000 BR R14 AND RETURN TO THE CALLER 00451000 SPACE 00452000 CFILERR EQU * 00453000 LA R15,X'09' SET I/O ERROR RETURN CODE 00454000 B CFILEXIT AND EXIT TO CALLER 00455000 EJECT 00456000 *. 00457000 * 00458000 * ENTRY NAME - 00459000 * 00460000 * CMSOPEN 00461000 * 00462000 * FUNCTION - 00463000 * 00464000 * INITIALIZE READING OF A CMS FILE 00465000 * 00466000 * CALLS TO OTHER ROUTINES - 00467000 * 00468000 * CMSFILCH - TO READ CMS DASD BLOCKS 00469000 * 00470000 * OPERATION - 00471000 * 00472000 * 1. CLEAR FILE READ STATUS VARIABLES 00473000 * 00474000 * 2. READ THE CMS MASTER FILE DIRECTORY (MFD) 00475000 * 00476000 * 3. READ AND SCAN THE CMS FILE STATUS TABLES (FST) 00477000 * TO LOCATE THE FILE TO BE READ 00478000 * 00479000 * 4. INITIALIZE THE VIRTUAL STORAGE FST FOR THE FILE 00480000 * TO BE READ 00481000 * 00482000 * 5. RETURN TO THE CALLER 00483000 * 00484000 * ENTRY CONDITIONS - 00485000 * 00486000 * THE FILENAME FILETYPE OF THE FILE TO BE READ MUST BE 00487000 * STORED IN THE 'OPENFILE' FIELD PRIOR TO CALLING. 00488000 * 00489000 * RESPONSES - 00490000 * 00491000 * GPR15 = X'07' ON RETURN IF FILE NOT FOUND 00492000 * 00493000 * ERROR MESSAGES - 00494000 * 00495000 * NONE 00496000 * 00497000 *. 00498000 SPACE 00499000 CMSOPEN EQU * 00500000 STM R14,R4,COPNSAVE SAVE CALLER'S REGISTERS 00501000 SR R15,R15 CLEAR R15 FOR RETURN AND ZEROING OF POINTERS 00502000 ST R15,NEXTITEM FORCE NEW DATA ITEM BLOCK READ 00503000 ST R15,NEXTBLOK FORCE NEW CHAIN LINK BLOCK READ 00504000 ST R15,NEXTLINK FORCE READ OF FIRST CHAIN LINK BLOCK 00505000 LA R1,4 R1=BLOCK NUMBER OF THE MASTER FILE DIRECTORY 00506000 BAL R14,CMSFILCH READ THE MASTER FILE DIRECTORY 00507000 LTR R15,R15 DID WE GET IT WITHOUT ERROR? 00508000 BNZ COPNEXIT NOPE - EXIT WITH FILCH ERROR CODE 00509000 MVC BLOKLIST(200),FILCHBUF MOVE SOME MFD FSTBLOCK POINTERS 00510000 MVC BLOKLIST+200(164),FILCHBUF+200 MOVE REMAINDER OF PTRS 00511000 LA R2,BLOKLIST-2 INITIALIZE FSTBLOCK POINTER ADDRESS REG 00512000 MVI BLOKLIST+364,X'FF' ENSURE PRESENCE OF SENTINEL 00513000 COPNGET EQU * 00514000 LA R2,2(R2) R2=ADDRESS OF NEXT FSTBLOCK NUMBER 00515000 CLI 0(R2),X'FF' IS THIS THE END OF THE FST BLOCKS? 00516000 BE COPNMISS YEP - FILE NOT FOUND 00517000 LH R1,0(R2) R1=BLOCK NUMBER OF NEXT FST BLOCK 00518000 BAL R14,CMSFILCH READ THE BLOCK INTO FILCHBUF 00519000 LTR R15,R15 DID WE READ IT O.K.? 00520000 BNZ COPNEXIT NOPE - EXIT WITH FILCH ERROR CODE 00521000 LA R3,FILCHBUF-STATLEN INITIALIZE FST POINTER REGISTER 00522000 LA R4,FILCHBUF+800 SET SEARCH LIMIT REGISTER 00523000 COPNNEXT EQU * 00524000 LA R3,STATLEN(R3) BUMP POINTER TO NEXT FST 00525000 CLR R3,R4 HAVE WE HIT THE END OF THE BLOCK YET? 00526000 BNL COPNGET YEP - TRY TO GET ANOTHER FST BLOCK 00527000 CLI 0(R3),X'00' IS THERE A FILE STAT TABLE HERE? 00528000 BE COPNGET NOPE - TRY TO GET ANOTHER BLOCK 00529000 CLC 0(16,R3),OPENFILE IS THIS THE FST WE WANT? 00530000 BNE COPNNEXT NOPE - TRY ANOTHER FST 00531000 MVC STATABLE(STATLEN),0(R3) GOT IT - INITIALIZE CORE TABLE 00532000 COPNEXIT EQU * 00533000 XC FILERNUM(2),FILERNUM NEXT READ ALWAYS FIRST AFTER OPEN 00534000 L R14,COPNSAVE RESTORE CALLER'S RETURN ADDRESS 00535000 LM R0,R4,COPNSAVE+8 RESTORE REMAINDER OF HIS REGISTERS 00536000 BR R14 AND RETURN WITH RETURN CODE IN R15 00537000 SPACE 00538000 COPNMISS EQU * 00539000 LA R15,X'07' R15=RETURN CODE 7 (FILE NOT FOUN 00540000 B COPNEXIT RESTORE REGS AND RETURN TO CALLER 00541000 EJECT 00542000 *. 00543000 * 00544000 * ENTRY NAME - 00545000 * 00546000 * CMSGET 00547000 * 00548000 * FUNCTION - 00549000 * 00550000 * GET THE NEXT CMS FILE ITEM 00551000 * 00552000 * CALLS TO OTHER ROUTINES - 00553000 * 00554000 * CMSFILCH - TO READ A CMS FILE BLOCK 00555000 * 00556000 * OPERATION - 00557000 * 00558000 * 1. LOCATE THE NEXT DATA ITEM - IF NONE, RETURN END 00559000 * OF FILE 00560000 * 00561000 * 2. IF THE DATA BLOCK HAS BEEN ENTIRELY READ, GO 00562000 * TO 'CGETBLOCK' TO GET THE NEXT DATA BLOCK 00563000 * 00564000 * 3. IF THE CHAIN LINK BLOCK HAS BEEN EXHAUSTED, GO TO 00565000 * 'CGETLINK' TO GET THE NEXT CHAIN LINK BLOCK (THE 00566000 * ALGORITHM FOR DECODING A CMS QQ ADDRESS, USED ONLY 00567000 * FOR THE FIRST CHAIN LINK SUB-BLOCK, IS ENCODED IN 00568000 * THIS ROUTINE) 00569000 * 00570000 * ENTRY CONDITIONS - 00571000 * 00572000 * THE CMS FILE ACCESS VARIABLE AREA MUST BE AS INITIALIZED 00573000 * BY CMSOPEN, OR AS LEFT ON A PREVIOUS CALL TO CMSGET. 00574000 * 00575000 * EXIT CONDITIONS - 00576000 * 00577000 * NORMAL - 00578000 * 00579000 * GPR0 = LENGTH OF NEXT CMS DATA ITEM 00580000 * GPR1 = ADDR OF START OF NEXT CMS DATA ITEM 00581000 * GPR15 = X'00' IMPLIES NORMAL RETURN 00582000 * 00583000 * ERROR - 00584000 * 00585000 * GPR15 = X'06' IF END OF FILE 00586000 * X'07' IF NO FILE ACTIVE (OPEN NOT CALLED) 00587000 * X'08' IF FILE FORMAT ERROR 00588000 * NON-ZERO RETURN CODE FROM CMSFILCH 00589000 * 00590000 * RESPONSES - 00591000 * 00592000 * NONE 00593000 * 00594000 * ERROR MESSAGES - 00595000 * 00596000 * NONE 00597000 * 00598000 *. 00599000 SPACE 00600000 CMSGET EQU * 00601000 STM R14,R4,CGETSAVE SAVE CALLER'S REGISTERS 00602000 SR R15,R15 CLEAR RETURN CODE TO START 00603000 CLI FILENAME,C' ' HAS A FILE BEEN INITIALIZED FOR READ? 00604000 BE CGETNULL NOPE - RETURN NO FILE ACTIVE ERROR CODE 00605000 L R1,NEXTITEM R1=ADDR OF NEXT ITEM IF WE HAVE ONE 00606000 ST R15,NEXTITEM CLEAR ITEM ADDRESS FIELD FOR NOW 00607000 LH R2,FILERNUM R2=LAST ITEM NUMBER GOTTEN 00608000 LA R2,1(R2) BUMP ITEM NUMBER UP ONE 00609000 CH R2,FILEINUM DOES THIS ITEM EXIST IN THE FILE? 00610000 BH CGETEOF NOPE - RETURN END OF FILE 00611000 STH R2,FILERNUM UPDATE LAST GOTTEN ITEM NUMBER 00612000 LTR R2,R1 HAVE WE HIT THE END OF THE DATA ITEM BLOCK? 00613000 BZ CGETBLOK YEP - BETTER GO TRY TO GET ANOTHER 00614000 CGETIGOT EQU * 00615000 L R0,FILEILEN R0=FILE DATA ITEM LENGTH 00616000 ALR R2,R0 R2=ADDRESS OF NEXT DATA ITEM IN BLOCK 00617000 CL R2,ITEMEND DID WE GO PAST THE END OF THE BLOCK? 00618000 BNL CGETEXIT YEP - LEAVE NEXT ITEM ZEROED 00619000 ST R2,NEXTITEM OTHERWISE SET ADDRESS FOR NEXT GET CALL 00620000 CGETEXIT EQU * 00621000 L R14,CGETSAVE R14=CALLER'S RETURN ADDRESS 00622000 LM R2,R4,CGETSAVE+16 RESTORE NON-RETURN REGISTERS 00623000 BR R14 AND RETURN TO CALLER 00624000 SPACE 00625000 CGETBLOK EQU * 00626000 L R1,NEXTBLOK R1=ADDRESS OF NEXT DATA BLOCK NUMBER 00627000 XC NEXTBLOK(4),NEXTBLOK CLEAR NEXT POINTER FOR NOW 00628000 LTR R3,R1 DO WE HAVE ADDRESS FOR ANOTHER DATA BLOCK? 00629000 BZ CGETLINK NO - GO TRY TO READ A CHAIN LINK BLOCK 00630000 CGETBGOT EQU * 00631000 LH R1,0(R1) R1=CMS BLOCK NUMBER FOR NEXT DATA BLOCK 00632000 LTR R1,R1 IS THERE ANOTHER DATA BLOCK IN FACT? 00633000 BZ CGETERR NOPE - SOMETHING IS FOULED UP 00634000 BAL R14,CMSFILCH GO READ THE NEXT DATA BLOCK INTO FILCHBUF 00635000 LTR R15,R15 DID THAT WORK PROPERLY? 00636000 BNZ CGETEXIT EXIT WITH FILCH ERROR CODE IF NOT 00637000 LA R1,FILCHBUF R1=ADDRESS OF FIRST DATA ITEM IN BUF 00638000 LR R2,R1 SET UP R2 THE SAME FOR RETURN BRANCH 00639000 LA R3,2(R3) R3=ADDR OF NEXT DATA BLOCK POINTER 00640000 CL R3,BLOKEND SHOULD WE UPDATE NEXT BLOCK POINTER? 00641000 BNL CGETIGOT NOPE - LEAVE IT ZERO TO FORCE CHAIN LINK READ 00642000 ST R3,NEXTBLOK OTHERWISE SET IT TO UPDATED VALUE 00643000 B CGETIGOT AND RETURN WITH DATA ITEM 00644000 EJECT 00645000 CGETLINK EQU * 00646000 L R1,NEXTLINK R1=ADDR OF NEXT CHAIN LINK BLOCK NUMBER 00647000 CL R1,LINKEND IS IT PAST THE UPPER LIMIT? 00648000 BNL CGETERR THINGS ARE BADLY ASTRAY IF SO 00649000 LTR R4,R1 IS THIS THE FIRST GET REQUEST AFTER OPEN? 00650000 BNZ CGETMAX NOPE - GO GET A FULL SIZE CHAIN LINK BLOCK 00651000 SR R0,R0 CLEAR OFFSET INDEX REG 00652000 SR R1,R1 CLEAR REG.1 FOR INSERT 00653000 ICM R1,B'0011',FILELINK LOAD HALF LOGICAL 00654000 CLI DASD+DEVCODE-IOTABLE,TYP2314 2314 DISK IN USE? 00655000 BNE CGETFILC DON'T FOOL WITH ADDR IF NOT 00656000 TM FILELINK,X'20' IS BIT 2 ON? 00657000 BNO CGETOFF NO - CLEAR HIGH ORDER TWO BITS 00658000 TM FILELINK,X'80' IS BIT 0 SET TO ONE? 00659000 BNO CGETFILC O.K. AS IS IF NOT 00660000 S R1,=A(X'6000') IN THE MYSTIC WAYS OF ALLAH ... 00661000 B CGETFILC GET THE CALCULATED BLOCK NUMBER 00662000 CGETOFF EQU * 00663000 SLL R1,16 LEFT JUSTIFY BLOCK NUMBER 00664000 SLDL R0,2 RETAIN HIGH TWO BITS 00665000 SRL R1,18 AND RE-JUSTIFY THE ADDR 00666000 CGETFILC EQU * 00667000 BAL R14,CMSFILCH GO READ THE FIRST CHAIN LINK 00668000 LTR R15,R15 DID THE READ WORK? 00669000 BNZ CGETEXIT NOPE - FORGET THE WHOLE THING 00670000 LTR R1,R0 LOAD POINT ADJUSTMENT TO DO? 00671000 BZ CGETSKIP NO - SKIP MULITPLY 00672000 LA R2,200 BYTES PER QUARTER BLOCK 00673000 MR R0,R2 DISPLACEMENT INTO BLOCK 00674000 CGETSKIP EQU * 00675000 LA R3,FILCHBUF(R1) ACTUAL ADDR OF FCL SUB-BLOCK 00676000 MVC LINKLIST(80),0(R3) MOVE LIST OF N CHAIN LINKS TO BUF 00677000 MVC BLOKLIST(120),80(R3) MOVE LIST OF DATA BLOCKS TO BU 00678000 LA R3,BLOKLIST+120 R3=CURRENT BLOCK LIST BUFFER LIMIT 00679000 ST R3,BLOKEND SET BLOCK LIST BUFFER LIMIT FIELD 00680000 LA R4,LINKLIST INITIALIZE CHAIN LINK BLOCK NUMBER POINTER 00681000 CGETLGOT EQU * 00682000 ST R4,NEXTLINK SAVE ADDR OF NEXT CHAIN LINK BLOCK NUMBER 00683000 LA R1,BLOKLIST R1=ADDR OF START OF DATA BLOCK NUMBERS 00684000 LR R3,R1 R3=SAME THING FOR RETURN TO BLOCK GET ROUTINE 00685000 B CGETBGOT RETURN TO BLOCK GETTER 00686000 SPACE 00687000 CGETMAX EQU * 00688000 LH R1,0(R1) R1=BLOCK NUMBER OF NEXT CHAIN LINK 00689000 LTR R1,R1 IS THERE SUCH A BLOCK NUMBER HERE? 00690000 BNP CGETERR NOPE - ALL FOULED UP - QUIT 00691000 BAL R14,CMSFILCH READ IN THE NEXT CHAIN LINK BLOCK 00692000 LTR R15,R15 DID THE READ WORK SUCCESSFULLY? 00693000 BNZ CGETEXIT QUIT WITH FILCH ERROR CODE IF NOT 00694000 MVC BLOKLIST(200),FILCHBUF MOVE FIRST QUARTER OF CHAIN LINK 00695000 MVC BLOKLIST+200(200),FILCHBUF+200 MOVE THE SECOND QUARTER 00696000 MVC BLOKLIST+400(200),FILCHBUF+400 MOVE THE THIRD 00697000 MVC BLOKLIST+600(200),FILCHBUF+600 AND THE FOURTH 00698000 LA R3,BLOKLIST+800 R3=MAXIMUM BLOCK LIST BUFFER LIMIT 00699000 ST R3,BLOKEND SET LIMIT FIELD TO CURRENT VALUE 00700000 LA R4,2(R4) BUMP CHAIN LINK BLOCK NUMBER POINTER TO NEXT 00701000 B CGETLGOT GO FINISH UP AND RETURN TO BLOCK GETTER 00702000 SPACE 2 00703000 CGETEOF EQU * 00704000 LA R15,X'06' SET RETURN CODE 6 (END OF FILE) 00705000 LM R0,R1,CGETSAVE+8 SET UP REGS. 0 & 1 AS CALLER HAD THEM 00706000 B CGETEXIT AND RETURN TO CALLER LIKE THAT 00707000 SPACE 00708000 CGETNULL EQU * 00709000 LA R15,X'07' SET RETURN CODE 7 (NO FILE ACTIV 00710000 LM R0,R1,CGETSAVE+8 SET UP REGS. 0 & 1 AS CALLER HAD THEM 00711000 B CGETEXIT RETURN TO CALLER 00712000 SPACE 00713000 CGETERR EQU * 00714000 LA R15,X'08' SET RETURN CODE 8 (FILE FORMAT ERR 00715000 LM R0,R1,CGETSAVE+8 SET UP REGS. 0 & 1 AS CALLER HAD THEM 00716000 B CGETEXIT RETURN TO CALLER 00717000 EJECT 00718000 *---------------------------------------------------------------------* 00719000 * * 00720000 * CMS P-DISK ACCESS CONTROL AREA * 00721000 * * 00722000 *---------------------------------------------------------------------* 00723000 SPACE 00724000 DASD DC 0F'0' CMS DASD I/O REQUEST TABLE 00725000 DC F'0' SYNCH LOCK 00726000 DC AL2(0) DASD DEV ADDR (SET BY INIT) 00727000 DC AL1(24) SENSE INFO REQ FOR DASD 00728000 DC X'00' DEVICE TYPE CODE (SET BY INIT) 00729000 DC A(DASDREAD) ADDR OF DISK READ CHAN PROG 00730000 DC 2F'0' RETURN SIO COND CODE & END CSW 00731000 DC 24X'00' RETURN SENSE INFO ON U CHECK 00732000 DMTCREDA EQU DASD 00733000 SPACE 00734000 * THE FOUR VALUES BELOW ARE SET BY INIT ACCORDING TO THE 00735000 * TYPE OF DASD TO BE USED FOR LOADING 00736000 PERCYL DC F'0' CMS RECORDS/CYL 00737000 PERTRACK DC F'0' CMS RECORDS/X (TRACK OR PAIR) 00738000 OVERNUM DC F'0' RECORD NUMBER OF OVERLAPPER 00739000 DASDSECS DC 20X'00' REC NUMBER - SECTOR TABLE @V304498 00740100 SPACE 2 00741000 DASDREAD CCW X'07',BBCCHHR,CC+SILI,6 SEEK (BBCCHH) 00742000 DASETSEC CCW X'03',SECTOR,CC+SILI,1 NOP OR SET SECTOR 00743000 DASEARCH CCW X'31',BBCCHHR+2,CC+SILI,5 SEARCH ID EQUAL (CCHHR) 00744000 CCW X'08',DASEARCH,X'00',1 BACK TO SEARCH IF UNEQUAL 00745000 CCW X'86',FILCHBUF,SILI,800 READ DATA MULTI-TRACK 00746000 SPACE 00747000 BBCCHHR DC 0F'0',7X'00' DASD ADDR FOR REFERENCE 00748000 SECTOR DC X'00' SECTOR NUMBER OF REC ABOVE 00749000 SPACE 00750000 OPENFILE DC 0F'0',CL8' ',CL8'TEXT' FILE NAME FOR OPEN REQ 00751000 SPACE 00752000 STATABLE DC 0F'0' CMS FILE STATUS TABLE 00753000 FILENAME DC 8C' ' CMS FILE NAME 00754000 FILETYPE DC 8C' ' CMS FILE TYPE 00755000 FILEDATE DC F'0' CREATION DATE - DEC MMDDHHMM 00756000 FILEWNUM DC H'0' WRITE ITEM NUMBER 00757000 FILERNUM DC H'0' READ ITEM NUMBER 00758000 FILEMODE DC 2C' ' CMS FILE MODE 00759000 FILEINUM DC H'0' NUMBER OF ITEMS IN ENTIRE FILE 00760000 FILELINK DC H'0' CMS BLOCK NUMBER OF FIRST CHAIN LINK 00761000 FILEFORM DC C' ' FILE FORMAT: C'F' => FIXED; C'V' => VARIABLE 00762000 FILEFLAG DC X'00' FILE FLAGS - ALWAYS ZERO? 00763000 FILEILEN DC F'0' (MAXIMUM) LENGTH OF FILE DATA ITEMS 00764000 FILESIZE DC H'0' NUMBER OF 800 BYTE BLOCKS IN FILE 00765000 FILEYEAR DC 2C' ' YEAR OF FILE CREATION - LAST TWO DIGITS IN EBCDIC 00766000 STATLEN EQU *-STATABLE LENGTH OF CMS FILE STATUS TABLE 00767000 EJECT 00768000 DC 0D'0' 00769000 NEXTLINK DC A(0) ADDRESS OF POINTER TO NEXT CHAIN LINK 00770000 LINKEND DC A(LINKLIST+80) END OF CHAIN LINK LIST 00771000 LINKLIST DS 80C LIST OF CMS CHAIN LINK BLOCK NUMBERS 00772000 SPACE 00773000 DC 0D'0' 00774000 NEXTBLOK DC A(0) ADDRESS OF POINTER TO NEXT DATA BLOCK 00775000 BLOKEND DC A(BLOKLIST+120) END OF CURRENT DATA BLOCK LIST 00776000 BLOKLIST DS 800C LIST OF CMS FILE DATA BLOCK NUMBERS 00777000 SPACE 00778000 DC 0D'0' 00779000 NEXTITEM DC A(0) ADDRESS OF NEXT (UNREAD) DATA ITEM 00780000 ITEMEND DC A(FILCHBUF+800) END OF FILCH DATA BUFFER 00781000 FILCHBUF DS 800C BUFFER FOR CMS BLOCK FILCH ROUTINE 00782000 SPACE 00783000 CFILSAVE DS 8F SAVE AREA FOR CMS FILCH ROUTINE 00784000 COPNSAVE DS 7F SAVE AREA FOR CMS OPEN ROUTINE 00785000 CGETSAVE DS 7F SAVE AREA FOR CMS GET ROUTINE 00786000 EJECT 00787000 COPY SVECTORS 00788000 EJECT 00789000 COPY TAREA 00790000 EJECT 00791000 COPY LINKTABL 00792000 EJECT 00793000 COPY IOTABLE 00794000 EJECT 00795000 COPY RSSEQU 00796000 EJECT 00797000 COPY DEVTYPES 00798000 END 00799000