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