ibm:vm370-lib:rscs:dmtcre.assemble_src
Table of Contents
DMTCRE Source
References
- Fixes Applied : 0
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMTCRE.ASSEMBLE.txt
- 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
ibm/vm370-lib/rscs/dmtcre.assemble_src.txt · Last modified: 2023/08/06 13:39 by Site Administrator