ibm:vm370-lib:cms:dmstrk.assemble_src
Table of Contents
DMSTRK Source
References
- Fixes Applied : 0
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMSTRK.ASSEMBLE.txt
- TRK TITLE 'DMSTRK (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * MODULE NAME: 00008000
- * 00009000
- * DMSTRK (TRKLKP) 00010000
- * 00011000
- * SUBROUTINE NAME: 00012000
- * 00013000
- * DMSTRK 00014000
- * 00015000
- * FUNCTION: 00016000
- * 00017000
- * TO ALLOCATE AN 800-BYTE DISK AREA TO A CALLING 00018000
- * PROGRAM. 00019000
- * 00020000
- * ATTRIBUTES: 00021000
- * 00022000
- * NUCLEUS RESIDENT, REENTRANT 00023000
- * 00024000
- * ENTRY POINTS: 00025000
- * 00026000
- * DMSTRKA 00027000
- * 00028000
- * ENTRY CONDITIONS: 00029000
- * 00030000
- * L R15, ADMSTRK WHERE ATRKLKP=V(DMSTRKA) 00031000
- * BALR R14, R15 00032000
- * 00033000
- * R1 MUST POINT TO ACTIVE DISK TABLE BLOCK 00034000
- * R13 MUST POINT TO A SAVE-AREA OF AT LEAST ELEVEN WORDS 00035000
- * 00036000
- * EXIT CONDITIONS: 00037000
- * 00038000
- * NORMAL RETURN 00039000
- * 00040000
- * R1 CONTAINS DISK-ADDRESS OF AVAILABLE 800-BYTE AREA 00041000
- * (SEE FIGURE 25 FOR FORMAT) 00042000
- * 00043000
- * R15 =0 (AND CONDITION-CODE =0) 00044000
- * 00045000
- * VERY FEW RECORDS LEFT (ERROR 4) -NONFATAL 00046000
- * 00047000
- * R1 CONTAINS DISK-ADDRESS OF AVAILABLE 800-BYTE AREA 00048000
- * (SAME AS ABOVE) 00049000
- * 00050000
- * R15=4 (AND CONDITION-CODE=2) 00051000
- * 00052000
- * ERROR BY CALLER (ERROR 2) 00053000
- * 00054000
- * R1 SAME AS AT ENTRY 00055000
- * R15=2 (AND CONDITION-CODE=2) 00056000
- * 00057000
- * CALLS TO OTHER ROUTINES: 00058000
- * 00059000
- * NONE 00060000
- * 00061000
- * EXTERNAL REFERENCES: 00062000
- * 00063000
- * ADTSECT 00064000
- * 00065000
- * TABLES/WORKAREAS: 00066000
- * 00067000
- * NONE. 00068000
- * 00069000
- * REGISTER USAGE: 00070000
- * 00071000
- * ADTSECT - R1 00072000
- * BASE - R11 00073000
- * REST - WORK 00074000
- * 00075000
- * OPERATION: 00076000
- * 00077000
- * NOTES: DMSTRKA CHECKS FOR ERRORS BY THE CALLER 00078000
- * AND AN ERROR 2 (WITH ERROR HALT FIRST) IS GIVEN IF 00079000
- * SUCH OCCURRED. 00080000
- * 00081000
- * DMSTRKA NOW REMEMEBERS (IN ADTIST) THE DISPLACEMENT 00082000
- * OF THE FIRST 00083000
- * FULLWORD IN THE QMSK THAT HAS A ZERO-BIT IN IT 00084000
- * ANYWHERE, TO 00085000
- * SPEED UP SEARCHES AFTER THE FIRST CALL TO DMSTRKA FOR 00086000
- * ANY DISK. (DMSTRKX OF COURSE MAINTAINS THIS WORD WHEN 00087000
- * RECORDS ARE 00088000
- * RETURNED.) 00089000
- * 00090000
- * WHEN THE NUMBER OF RECORDS REMAINING ON THE GIVEN 00091000
- * DISK NO LONGER EXCEEDS A RESERVE COUNT (ADTRES) THAT 00092000
- * IS MAINTAINED BY THE FILE SYSTEM, AN ERROR 4 00093000
- * (INDICATING VERY FEW RECORDS LEFT) IS RETURNED. 00094000
- * THIS FEATURE ENABLES DMSBWR OR DMSTQQ, ON THE ONE 00095000
- * HAND, TO RETURN THE RECORD VIA DMSTRKX AND INVOKE THE 00096000
- * DISK IS FULL LOGIC. WHILE DMSAUD, ON THE 00097000
- * OTHER HAND, CAN USE THE RECORD 00098000
- * FOR COMPLETING THE NEW USER FILE DIRECTORY. (THIS IS 00099000
- * PART OF CMS'S DOUBLE DIRECTORY SCHEME FOR MAXIMUM 00100000
- * FILE INTEGRITY.) 00101000
- * 00102000
- * MODULE NAME: 00103000
- * 00104000
- * DMSTRK 00105000
- * 00106000
- * SUBROUTINE NAME: 00107000
- * 00108000
- * DMSTRKX (TRKLKPX) 00109000
- * 00110000
- * FUNCTION: 00111000
- * 00112000
- * TO MAKE AN 800-BYTE DISK AREA THAT IS NO LONGER 00113000
- * NEEDED BY ONE PROGRAM AVAILABLE FOR ALLOCATION TO 00114000
- * ANOTHER. 00115000
- * 00116000
- * ATTRIBUTES: 00117000
- * 00118000
- * NUCLEUS RESIDENT, REENTRANT 00119000
- * 00120000
- * ENTRY POINTS: 00121000
- * 00122000
- * DMSTRKX 00123000
- * 00124000
- * ENTRY CONDITIONS: 00125000
- * 00126000
- * L R15, ADMSTRKX WHERE ATRKLKPX= V(DMSTRKX) 00127000
- * BALR R14, R15 00128000
- * 00129000
- * R0 (RIGHTMOST 16 BITS) MUST HOLD THE DISK ADDRESS 00130000
- * OF THE 00131000
- * 800-BYTE DISK AREA BEING RETURNED. (SEE FIGURE 00132000
- * 25 FOR FORMAT) 00133000
- * 00134000
- * R1 MUST POINT TO ACTIVE DISK TABLE BLOCK 00135000
- * R13 MUST POINT TO A SAVE-AREA OF AT LEAST ELEVEN 00136000
- * WORDS 00137000
- * 00138000
- * EXIT CONDITIONS: 00139000
- * 00140000
- * NORMAL RETURN 00141000
- * 00142000
- * R15=0 00143000
- * 00144000
- * ERROR BY CALLER _ERROR 2_ 00145000
- * 00146000
- * R15=2 (AND CONDITION-CODE = 2) 00147000
- * 00148000
- * OUT OF RANGE 800_BYTE AREA RETURNED _ERROR 5_ 00149000
- * 00150000
- * R15=5 (AND CONDITION-CODE=2) 00151000
- * 00152000
- * ALREADY CLEAR 800_BYTE AREA RETURNED _ERROR 6_ 00153000
- * 00154000
- * R15=6 (AND CONDITION-DOCE=2) 00155000
- * 00156000
- * CALLS TO OTHER ROUTINES: 00157000
- * 00158000
- * NONE 00159000
- * 00160000
- * EXTERNAL REFERENCES: 00161000
- * 00162000
- * ADTSECT 00163000
- * 00164000
- * TABLES WORKAREAS: 00165000
- * 00166000
- * NONE. 00167000
- * 00168000
- * REGISTER USAGE: 00169000
- * 00170000
- * R15 - BASE 00171000
- * R1 - ADTSECT 00172000
- * REST - WORK 00173000
- * 00174000
- * OPERATION: 00175000
- * 00176000
- * NOTES: DMSTRKX CHECKS, AS DOES DMSTRKA, FOR 00177000
- * ERRORS BY THE CALLER, AND AN ERROR 2 (WITH ERROR HALT 00178000
- * FIRST) IS GIVEN IF SUCH AN ERROR OCCURRED. 00179000
- * 00180000
- * DMSTRKX NOW MAINTAINS (IN ADTIST) THE DISPLACEMENT OF 00181000
- * THE 00182000
- * FIRST FULL WORD IN THE XMSK THAT HAS A ZERO-BIT IN IT 00183000
- * ANYWHWERE (THIS BEING USED BY DMSTRKX FOR SPEEDING UP 00184000
- * THE 00185000
- * SEARCH OF THE QMSK TABLE). 00186000
- * 00187000
- * DMSTRKX IS AN ENTRY-POINT IN THE DMSTRK ROUTINE. 00188000
- * 00189000
- *. 00190000
- EJECT 00191000
- TRKLKP START 0 00192000
- SPACE 00193000
- ENTRY DMSTRK P3035 00194000
- DMSTRK EQU TRKLKP P3035 00195000
- ENTRY DMSTRKX P3035 00196000
- ENTRY TRKLKPX 00197000
- SPACE 00198000
- * 00199000
- * ENTER 'TRKLKP' HERE ... 00200000
- USING TRKLKP,R11 00201000
- STM R2,R12,0(R13) SAVE 11 REGISTERS 00202000
- LR R11,R15 ADDRESSABILITY IN R11 NOW 00203000
- LA R15,TRKLKPX COMMON ADDRESSABILITY FOR SUBROUTINE, 00204000
- BAL R2,TRKSUB CALL INITIALIZING SUBROUTINE 00205000
- USING ADTSECT,R1 REFERENCE ALL QUANTITIES BY R1 NOW 00206000
- * NOTE ... 00207000
- * R3 AND R12 POINT TO BIT-MASK (PQMSK) 00208000
- * R6 = DISP. OF 1ST WORD WITH 'HOLE' IN IT 00209000
- * R7 = NUMTRKS = TOTAL NO. OF QTR-TRKS ON P- OR T-DISK 00210000
- * R8 = QTUSEDP = NO. OF QTR-TRKS IN USE 00211000
- * R9 = QTLEFTP = NO. OF QTR-TRKS LEFT 00212000
- * R10 = LASTRK = RELATIVE BYTE-ADDRESS OF LAST QTR-TRK 00213000
- * COMES HERE IF WE HAVE A BONA-FIDE READ-WRITE DISK: 00214000
- LA R4,4 BYTE INCREMENT (ONE FULL WORD) FOR LOOP 00215000
- LR R5,R7 OBTAIN TOTAL NUMBER OF BITS, 00216000
- LA R5,7(,R5) ROUND BEFORE CONVERTING ... @VA03452 00216100
- SRA R5,3 CHANGE TO BYTES, 00217000
- BCTR R5,0 SUBTRACT ONE FOR BXLE, NOW HAVE 'LENGTH' 00218000
- AR R5,R3 ADD STARTING-ADDRESS, 'LIMIT' ALL SET NOW 00219000
- LA R15,BLANK FOR BRANCHING 00220000
- SR R2,R2 WORD OF ALL ONES 00221000
- BCTR R2,0 (-1) INTO R2 00222000
- AR R3,R6 ADJUST R3 TO START WITH 1ST NONZERO WORD 00223000
- AGAIN CL R2,0(,R3) COMPARE G.P. 2 WITH NEXT MASK WORD 00224000
- BCR 7,R15 BLANK FOUND, GO TO BLANK 00225000
- BXLE R3,R4,AGAIN NO BLANK IN THAT WORD 00226000
- ERROR1 LM R2,R12,0(R13) RESTORE NECESSARY REGISTERS 00227000
- LA R15,1 ERROR NUMBER 1 00228000
- BR R14 AND RETURN (ERROR CODE 1) 00229000
- * 00230000
- BLANK LR R6,R3 COMPUTE NEW VALUE OF 'ADT1ST' 00231000
- SR R6,R12 (WILL STORE LATER) 00232000
- LA R4,1 BYTE INCREMENT OF ONE NOW, 00233000
- AGAINB TM 0(R3),X'FF' IS BLANK IN THIS BYTE 00234000
- BC 12,BLANKB G.P. 3 POINTS TO BYTE WITH BLANK 00235000
- BXLE R3,R4,AGAINB UPDATE G.P. 3, TRY AGAIN 00236000
- B ERROR1 ERROR IF DROPS THRU BXLE 00237000
- BLANKB LR R2,R3 LOAD 2 WITH ADDRESS OF BYTE 00238000
- SR R2,R12 GIVES NUMBER OF BYTES SCANNED 00239000
- * 00240000
- CR R2,R10 SEE IF THIS EXCEEDS OLD 'LASTRK' 00241000
- BNH UPD89 BNH IF NOT A 'NEW HIGH'. 00242000
- LR R10,R2 STORE NEW 'LASTRK' IF R2 WAS LARGER. 00243000
- UPD89 AR R8,R4 UPDATE R8 = NO. TRACKS IN USE (R4 WAS 1) 00244000
- LR R9,R7 COMPUTE HOW MANY 00245000
- SR R9,R8 TRACKS (IF ANY) ARE LEFT 00246000
- BM ERROR1 ERROR 1 IF NEGATIVE (NONE LEFT) @VA03452 00246100
- STM R6,R10,ADT1ST STORE ALL UPDATED DISK COUNTERS 00247000
- * 00248000
- SLL R2,3 LET R2 = BIT-COUNT (FROM BYTE-COUNT) 00249000
- IC R4,0(,R3) OBTAIN THE BYTE WITH THE 'BLANK' IN IT, 00250000
- TM 0(R3),X'F0' IS THE LEFT HALF ALL ONES ? 00251000
- BNO TRK01 BNO IF NOT (BLANK IS IN LEFT HALF) 00252000
- LA R5,4 IF BLANK IN RIGHT HALF, LET R5=4, 00253000
- N R4,=X'0000000F' ISOLATE RIGHTMOST FOUR BITS 00254000
- B TRK02 JOIN CODE BELOW. 00255000
- TRK01 SR R5,R5 IF BLANK IN LEFT HALF, CLEAR R5, 00256000
- SRL R4,4 POSITION R4 TO RIGHTMOST 4 BITS, 00257000
- TRK02 IC R4,TRKTBL(R4) PICK UP NUMBER FROM TABLE (0 TO 3) 00258000
- AR R4,R5 ADD 0 OR 4 FOR LEFT OR RIGHT HALF, 00259000
- AR R2,R4 R2 NOW HOLDS 'BLOCK NUMBER' FROM 0 UP. 00260000
- LA R5,X'80' SET R5 TO THE BIT WE 00261000
- SRL R5,0(R4) SHOULD 'OR' INTO THE BIT-TABLE, 00262000
- IC R4,0(,R3) OBTAIN THE OLD BYTE FROM THE TABLE, 00263000
- OR R4,R5 'OR' IN THE PROPER NEW BIT, 00264000
- STC R4,0(,R3) AND REPLACE THE BYTE. 00265000
- SR R15,R15 CLEAR ERROR CODE 00266000
- CH R9,ADTRES IS NO. LEFT > RESRVCNT ? 00267000
- BH ENUF BH IF ENOUGH LEFT, NO PROBLEM 00268000
- LA R15,4 SET ERROR CODE 4 IF 'FEW' LEFT 00269000
- ENUF LA R1,1(,R2) BLOCK NUMBER (FROM 1 UP) INTO R1 00270000
- LM R2,R12,0(R13) RESTORE NECESSARY REGISTERS 00271000
- LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00272000
- BR R14 RETURN 00273000
- * 00274000
- DROP R11 00275000
- DROP R1 00276000
- EJECT 00277000
- ********************************************************************** 00278000
- * 00279000
- * TRKLKPX - UNALLOCATE 1/4 TRACKS FROM DISK 00280000
- * 00281000
- ********************************************************************** 00282000
- * 00283000
- * 00284000
- USING *,R15 00285000
- TRKLKPX STM R2,R12,0(R13) SAVE 11 REGISTERS 00286000
- DMSTRKX EQU TRKLKPX P3035 00287000
- BAL R2,TRKSUB CALL INITIALIZING SUBROUTINE 00288000
- USING ADTSECT,R1 REFERENCE ALL QUANTITIES BY R1 NOW 00289000
- C R0,MINLEGAL BLK NO. MINUS, 0, OR BELOW MFD ? @VA01100 00289100
- BNH ERROR5 'OUT OF RANGE' IF NOT ABOVE MFD @VA01100 00289200
- LR R3,R0 SET UP R3 FOR 00290000
- BCTR R3,0 BLOCK-NUMBER-LESS-1. 00291000
- LR R4,R3 DETERMINE WORD 00292000
- SRA R4,3 AND BIT LOCATION WITHIN WORD 00293000
- LR R2,R4 SAVE R4 = RELATIVE BYTE-ADDRESS FOR LATER 00294000
- CR R2,R10 MAKE SURE WITHIN PQMSK RANGE 00295000
- BH ERROR5 BH IF 'OUT OF RANGE', ERROR NO. 5. 00296000
- N R4,=X'FFFFFFFC' LOCATION OF CORRECT WORD 00297000
- N R3,=X'0000001F' BIT LOCATION WITHIN WORD 00298000
- L R5,=X'80000000' BIT 0 00299000
- SRL R5,0(R3) SHIFT CORRECT NO. OF PLACES 00300000
- CR R4,R6 ARE WE BELOW OLD 'ADT1ST' ? 00301000
- BNL R6OK BNL IF NOT. 00302000
- LR R6,R4 NEW DISPLACEMENT 1ST WORD WITH HOLE 00303000
- R6OK N R5,0(R12,R4) SEE IF BIT IN PQMSK IS ALREADY 0 (ERROR) 00304000
- BZ ERROR6 BZ IF YES, ALREADY-CLEAR, ERROR 6. 00305000
- X R5,0(R12,R4) REMOVE BIT FROM MASK 00306000
- ST R5,0(R12,R4) STORE NEW WORD WITH BIT MASKED OUT. 00307000
- CR R2,R10 SEE IF THIS BYTE MATCHES 'LASTRK' 00308000
- BL R10OK FORGET IT IF LESS. 00309000
- AR R10,R12 IF =, ADD BASE-ADDRESS (FOR 'TM') 00310000
- LA R2,TMLOOP FOR 'BCTR' BELOW 00311000
- LA R3,SUB10 FOR 'BNZ' BELOW 00312000
- TMLOOP TM 0(R10),X'FF' CHECK BYTE AT HIGHEST ADDRESS 00313000
- BCR 7,R3 'BNZ TO SUB10' IF NOT ALL ZERO. 00314000
- BCTR R10,R2 DECREMENT R10 AND ITERATE TMLOOP. 00315000
- SUB10 SR R10,R12 MAKE R10 'RELATIVE' AGAIN (AFTER 'TM') 00316000
- R10OK BCTR R8,0 DECREMENT NO. QTR-TRKS IN USE, 00317000
- LR R9,R7 COMPUTE NEW 'NO. TRKS LEFT' 00318000
- SR R9,R8 ... 00319000
- STM R6,R10,ADT1ST STORE ALL UPDATED DISK COUNTERS 00320000
- LM R2,R12,0(R13) RESTORE NECESSARY REGISTERS 00321000
- SR R15,R15 INDICATE NO ERROR 00322000
- BR R14 RETURN TO CALLER 00323000
- EJECT 00324000
- TRKSUB LTR R1,R1 CHECK P-LIST 00325000
- BNP ERROR2 ERROR IF NOT PLUS AND NONZERO 00326000
- TM ADTFLG1,ADTFRW MUST BE A READ-WRITE DISK 00327000
- BZ ERROR2 ERROR IF NOT 00328000
- TM ADTFLG2,ADTFMFD AND MFD MUST BE IN CORE 00329000
- BZ ERROR2 ERROR IF NOT 00330000
- LM R6,R10,ADT1ST DISK COUNTERS INTO R6 THRU R10 00331000
- L R3,ADTMSK ADDRESS OF BIT-MASK INTO R3 00332000
- LTR R12,R3 ALSO INTO R12, AND CHECK IT 00333000
- BCR 7,R2 OK IF PRESENT, RETURN VIA R2 TO CALLER. 00334000
- * 00335000
- ERROR2 LM R2,R12,0(R13) ERROR 2 IF PARAMETER-LIST ERROR 00336000
- LA R15,2 OR DISK NOT THERE, ETC. 00337000
- LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00339000
- BR R14 00340000
- SPACE 2 00341000
- ERROR5 LM R2,R12,0(R13) 'OUT-OF-RANGE' QTR-TRACK RETURNED 00342000
- LA R15,5 ERROR NO. 5 00343000
- LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00344000
- BR R14 (NEW 7 NOVEMBER 1967 -- JAS) 00345000
- * 00346000
- ERROR6 LM R2,R12,0(R13) 'ALREADY CLEAR' QTR-TRACK RETURNED 00347000
- LA R15,6 ERROR NO. 6 00348000
- LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00349000
- BR R14 (NEW 7 NOVEMBER 1967 -- JAS) 00350000
- EJECT 00351000
- ********************************************************************** 00352000
- * 00353000
- * STORAGE AND DEFINITIONS 00354000
- * 00355000
- ********************************************************************** 00356000
- * 00357000
- PRINT DATA 00358000
- MINLEGAL DC F'4' BLOCK NUMBER OF "MFD" @VA01100 00358100
- TRKTBL DC 8AL1(0),4AL1(1),2AL1(2),1AL1(3) 00359000
- * 00360000
- * DEFINITIONS ... 00361000
- REGEQU 00362000
- EJECT 00363000
- ADT 00364000
- END 00365000
ibm/vm370-lib/cms/dmstrk.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator