ibm:vm370-lib:cms:dmsbrd.assemble_src
Table of Contents
DMSBRD Source
References
- Fixes Applied : 5
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R14460DS]
Source Listing
- DMSBRD.ASSEMBLE.txt
- BRD TITLE 'DMSBRD (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * MODULE NAME: 00004000
- * 00005000
- * DMSBRD (RDBUF) 00006000
- * 00007000
- * FUNCTION: 00008000
- * 00009000
- * TO READ ONE OR MORE SUCCESSIVE ITEMS FROM A SPECIFIED 00010000
- * FILE. 00011000
- * 00012000
- * ATTRIBUTES: 00013000
- * 00014000
- * RESIDENT, REENTRANT, CALLED VIA EITHER AN SVC OR 00015000
- * BALR. 00016000
- * 00017000
- * ENTRY POINT: 00018000
- * 00019000
- * DMSBRD - READ ONE OR MORE ITEMS FROM A FILE. 00020000
- * 00021000
- * ENTRY CONDITIONS: 00022000
- * 00023000
- * LA R1,PLIST R1 MUST POINT TO P-LIST AS USUAL 00024000
- * THEN EITHER 00025000
- * SVC X'CA' CALL RDBUF VIA SVC 00026000
- * DC AL4(RDERROR) ERROR-RETURN (FOR EXAMPLE, IF END-OF-FILE) 00027000
- * OR 00028000
- * L R15,ARDBUF WHERE ARDBUF = V(RDBUF) 00029000
- * BALR R14,R15 CALL RDBUF VIA BALR (WITHIN NUCLEUS) 00030000
- * BNZ RDERROR TRANSFER IF ERROR (FOR EXAMPLE, END-OF-FILE) 00031000
- * 00032000
- * 00033000
- * R1 MUST POINT TO RDBUF PARAMETER LIST: 00034000
- * DS 0F 00035000
- * PLIST DC CL8'RDBUF' (NOTE-IMMATERIAL IF CALLED BY BALR) 00036000
- * DC CL8' ' FILENAME 00037000
- * DC CL8' ' FILETYPE 00038000
- * DC CL2' ' FILEMODE 00039000
- * DC H' ' ITEM NO. OF FIRST (OR ONLY) ITEM TO BE READ 00040000
- * DC A( ) ADDRESS OF BUFFER INTO WHICH ITEM(S) READ 00041000
- * TO BE PLACED (THAT IS, ADDRESS OF INPUT BUF 00042000
- * DC F' ' SIZE OF INPUT BUFFER 00043000
- * DC CL1' ' F/V FLAG @VA03023 00044000
- * DC CL1' ' INDICATION OF NULL RECORD @VA03023 00045000
- * RETURNED HERE 00046000
- * DC H' ' NUMBER OF ITEMS TO BE READ 00047000
- * DC A(*-*) NUMBER OF BYTES READ RETURNED HERE 00048000
- * 00049000
- * EXIT CONDITIONS: 00050000
- * 00051000
- * NORMAL RETURN: 00052000
- * R15=0 (AND CONDITION CODE = 0) 00053000
- * 00054000
- * ERROR RETURN: 00055000
- * R15 NONZERO (AND CONDITION CODE = 2) 00056000
- * 00057000
- * ERROR RETURNS (R15 VALUE AT EXIT): 00058000
- * 00059000
- * 1. GIVEN FILE NOT FOUND. 00060000
- * 00061000
- * 2. BUFFER AREA NOT WITHIN USER STORAGE LIMITS. 00062000
- * 00063000
- * 3. PERMANENT DISK ERROR FROM RDTK. 00064000
- * 00065000
- * 5. NUMBER OF ITEMS = 0. 00066000
- * 00067000
- * 7. FIXED/VARIABLE FLAG IN FST ENTRY IS NOT "F" OR "V". 00068000
- * OR "V"). 00069000
- * 00070000
- * 8. GIVEN MEMORY AREA WAS SMALLER THAN ACTUAL SIZE OF ITEM 00071000
- * READ (NOTE: NONFATAL; NUMBER OF BYTES CORRESPONDING TO 00072000
- * SIZE OF BUFFER HAVE BEEN READ). 00073000
- * 00074000
- * 9. FILE OPEN FOR WRITING - MUST BE CLOSED BEFORE IT CAN BE 00075000
- * READ. 00076000
- * 00077000
- * 11. NUMBER OF ITEMS GREATER THAN 1, FOR VARIABLE-LENGTH 00078000
- * FILE. 00079000
- * 00080000
- * 12. END OF FILE (ITEM NUMBER SPECIFIED EXCEEDS NUMBER OF 00081000
- * ITEMS IN FILE) 00082000
- * 00083000
- * 13. VARIABLE FILE HAS INVALID DISPLACEMENT IN ACTIVE FILE 00084000
- * TABLE (INDICATES CODING ERROR--SHOULD NOT OCCUR). 00085000
- * 00086000
- * NOTE: ALL ERRORS EXCEPT ERROR 8 CAUSE THE FUNCTION 00087000
- * CALL TO BE ABORTED. ERROR 8 IS LEGITIMATE IF READING 00088000
- * THE FIRST PORTION OF A LARGE RECORD INTO A LITTLE 00089000
- * BUFFER. 00090000
- * 25. INSUFFICIENT FREE STORAGE AVAILABLE FOR FILE MANAGEMENT @VA02374 00091000
- * CONTROL AREAS. @VA02374 00092000
- * @VA02374 00093000
- * 00094000
- * 00095000
- * CALLS TO OTHER ROUTINES: 00096000
- * 00097000
- * ACTFREE, ACTLKP, DMSFREE, DMSFRET, FSTLKP, RDTK 00098000
- * 00099000
- * EXTERNAL REFERENCES: 00100000
- * 00101000
- * NONE 00102000
- * 00103000
- * TABLES/WORKAREAS: 00104000
- * 00105000
- * NONE 00106000
- * 00107000
- * REGISTER USAGE: 00108000
- * 00109000
- * R0 = WORK 00110000
- * R1 = ADDRESS OF PLIST 00111000
- * R2 - R11 = WORK 00112000
- * R12 = BASE REGISTER 00113000
- * R13 = BASE REGISTER FOR FVS DSECT 00114000
- * R14 = RETURN ADDRESS 00115000
- * R15 = BALR REGISTER 00116000
- * 00117000
- * NOTES: 00118000
- * 00119000
- * NONE 00120000
- * 00121000
- * OPERATION: 00122000
- * 00123000
- * AFTER PERFORMING SOME ERROR CHECKS, RDBUF CALLS 00124000
- * ACTLKP TO DETERMINE IF THE GIVEN FILE IS IN THE 00125000
- * ACTIVE FILE TABLE. IF IT IS FOUND BUT IS AN ACTIVE 00126000
- * WRITE, AN ERROR 9 IS GIVEN. IF AN ACTIVE READ, THEN 00127000
- * PROCESSING PROCEEDS AS DESCRIBED UNDER "FILE ACTIVE". 00128000
- * IF THE FILE IS ACTIVE BUT NEITHER A READ NOR A WRITE, 00129000
- * THEN IT MUST HAVE BEEN PLACED IN THE ACTIVE TABLE BY 00130000
- * A POINT FUNCTION CALL; PROCESSING CONTINUES AS 00131000
- * DESCRIBED BELOW AT THE POINT AFTER THE ENTRY IS 00132000
- * PLACED IN THE ACTIVE FILE TABLE BY ACTFREE. 00133000
- * 00134000
- * FILE NOT ACTIVE: 00135000
- * 00136000
- * IF THE FILE IS NOT FOUND BY ACTLKP IN THE ACTIVE FILE 00137000
- * TABLE, RDBUF CHECKS TO SEE IF THE FILE REFERENCED AT 00138000
- * STATEFST (LEFT BY THE MOST RECENT CALL TO STATE) 00139000
- * MATCHES THE CALLER'S PARAMETER LIST. (AS MANY 00140000
- * COMMANDS STATE A FILE TO FIND ITS EXISTENCE AND 00141000
- * CHARACTERISTICS AND THEN IMMEDIATELY RDBUF THE FIRST 00142000
- * RECORD, THERE IS A GOOD CHANCE THIS WILL OCCUR--THUS 00143000
- * SAVING A NEEDLESS SEARCH OF THE FST TABLES). IF FOUND 00144000
- * AT STATEFST, THE ADDRESSES OF THE ACTIVE DISK TABLE 00145000
- * AND THE FST ENTRY ITSELF ARE OBTAINED FROM THE EIGHT 00146000
- * BYTES IMMEDIATELY FOLLOWING THE STATEFST COPY, AND 00147000
- * FSTLKP IS NOT CALLED. (IF NOT FOUND BY FSTLKP, AN 00148000
- * ERROR 1 OCCURS). IF FOUND BY FSTLKP, OR FOUND IN 00149000
- * STATEFST AS ABOVE, THEN ACTFREE IS CALLED TO FIND OR 00150000
- * CREATE AN ENTRY IN THE ACTIVE FILE TABLE AND INSERT 00151000
- * THE 40-BYTE FST ENTRY THEREIN. 00152000
- * 00153000
- * WHEN THE FILE HAS BEEN PLACED IN THE ACTIVE FILE 00154000
- * TABLE (OR WAS ALREADY THERE FROM A POINT FUNCTION AS 00155000
- * MENTIONED ABOVE), RDBUF MARKS THE FILE AS BEING 00156000
- * ACTIVE. NEXT, RDBUF OBTAINS BUFFER SPACE INTO WHICH 00157000
- * TO READ THE DATA BLOCKS AND INTO WHICH TO READ THE 00158000
- * FIRST CHAIN LINK. IT THEN CALLS THE RDTK FUNCTION 00159000
- * PROGRAM TO READ THE FIRST CHAIN LINK INTO MAIN 00160000
- * STORAGE. RDBUF NEXT MOVES THE FIRST 80 BYTES OF THE 00161000
- * FIRST CHAIN LINK INTO THE CHAIN LINK DIRECTORY IN THE 00162000
- * ACTIVE FILE TABLE ENTRY. THEN RDBUF DETERMINES IF 00163000
- * THE ITEM(S) TO BE READ IS/ARE OF FIXED OR VARIABLE 00164000
- * LENGTH. IF OF VARIABLE LENGTH, PROCESSING PROCEEDS 00165000
- * AS DESCRIBED UNDER "VARIABLE-LENGTH ITEM" IN THIS 00166000
- * SECTION. IF OF FIXED LENGTH, PROCESSING PROCEEDS AS 00167000
- * DESCRIBED BELOW. 00168000
- * 00169000
- * FIXED-LENGTH ITEM: RDBUF CALCULATES THE NUMBER OF 00170000
- * BYTES TO BE READ. THIS IS EQUAL TO THE ITEM LENGTH 00171000
- * MULTIPLIED BY THE NUMBER OF ITEMS TO BE READ. IT 00172000
- * THEN CALCULATES (FROM THE ITEM NUMBER SUPPLIED IN THE 00173000
- * PARAMETER LIST) THE DATA BLOCK FROM WHICH THE ITEM(S) 00174000
- * IS/ARE TO BE READ. THIS CALCULATION ALSO YIELDS THE 00175000
- * DISPLACEMENT FROM THE START OF THE DATA BLOCK OF THE 00176000
- * FIRST BYTE TO BE READ. NEXT, RDBUF DETERMINES 00177000
- * WHETHER THE AFFECTED DATA BLOCK IS IN MAIN STORAGE. 00178000
- * IF IT IS NOT, RDBUF DETERMINES WHETHER THE CHAIN LINK 00179000
- * REQUIRED TO ACCESS THE NEEDED DATA BLOCK IS IN MAIN 00180000
- * STORAGE. IF THE REQUIRED CHAIN LINK IS NOT IN MAIN 00181000
- * STORAGE, RDBUF CALLS THE RDTK FUNCTION PROGRAM TO 00182000
- * READ IT INTO MAIN STORAGE. AFTER THE REQUIRED CHAIN 00183000
- * LINK HAS BEEN READ INTO MAIN STORAGE, OR IF IT IS 00184000
- * ALREADY IN MAIN STORAGE, RDBUF DETERMINES WHETHER THE 00185000
- * AFFECTED DATA BLOCK EXISTS. (IT WILL IF ITS 00186000
- * CORRESPONDING ENTRY IN THE CHAIN LINK THAT IS IN MAIN 00187000
- * STORAGE CONTAINS A VALID DISK ADDRESS.) IF THE 00188000
- * AFFECTED DATA BLOCK DOES NOT EXIST, RDBUF FILLS THE 00189000
- * INPUT BUFFER WITH ZEROES AND RETURNS TO THE CALLING 00190000
- * PROGRAM. IF IT DOES EXIST, RDBUF READS IT INTO THE 00191000
- * DATA BLOCK BUFFER. 00192000
- * 00193000
- * IF THE AFFECTED DATA BLOCK IS IN MAIN STORAGE WHEN 00194000
- * RDBUF IS CALLED, OR IF IT IS NOT, AFTER IT HAS BEEN 00195000
- * READ INTO MAIN STORAGE (IF NECESSARY), RDBUF 00196000
- * DETERMINES WHETHER IT CONTAINS ALL OF THE BYTES TO BE 00197000
- * READ. (IT WILL IF THE RESULT OF 800 MINUS THE 00198000
- * PREVIOUSLY CALCULATED DISPLACEMENT IS GREATER THAN OR 00199000
- * EQUAL TO THE NUMBER OF BYTES TO BE READ.) IF THE 00200000
- * DATA BLOCK CONTAINS ALL OF THE BYTES TO BE READ, 00201000
- * RDBUF MOVES THEM FROM THE DATA BLOCK BUFFER (WHERE 00202000
- * THE DATA BLOCK RESIDES) TO THE INPUT BUFFER AND 00203000
- * RETURNS TO THE CALLING PROGRAM. IF THE DATA BLOCK 00204000
- * DOES NOT CONTAIN ALL OF THE BYTES TO BE READ, RDBUF 00205000
- * MOVES THE PERTINENT BYTES FROM THE DATA BLOCK BUFFER 00206000
- * TO THE INPUT BUFFER. IT THEN READS THE NEXT DATA 00207000
- * BLOCK INTO MAIN STORAGE, OBTAINS THE REMAINING BYTES 00208000
- * TO BE READ FROM IT, MOVES THEM TO THE INPUT BUFFER, 00209000
- * AND RETURNS TO THE CALLING PROGRAM. (IF THE 800 00210000
- * BYTES IN THE NEXT DATA BLOCK ARE NOT SUFFICIENT TO 00211000
- * SATISFY THE READ, RDBUF MOVES THE ENTIRE 800 BYTES TO 00212000
- * THE INPUT BUFFER AND READS THE NEXT DATA BLOCK TO GET 00213000
- * THE REMAINING BYTES. RDBUF REPEATS THIS PROCEDURE 00214000
- * UNTIL THE NUMBER OF BYTES IN THE INPUT BUFFER EQUALS 00215000
- * THE NUMBER OF BYTES TO BE READ. IT THEN RETURNS TO 00216000
- * THE CALLING PROGRAM.) 00217000
- * 00218000
- * VARIABLE-LENGTH RECORD: RDBUF READS SUCCESSIVE DATA 00219000
- * BLOCKS (STARTING WITH THE FIRST) UNTIL IT LOCATES THE 00220000
- * ONE THAT CONTAINS THE START OF THE VARIABLE-LENGTH 00221000
- * ITEM TO BE READ. IT THEN MOVES THE ITEM LENGTH TO THE 00222000
- * START OF THE INPUT BUFFER. IF THE FIRST DATA BLOCK 00223000
- * CONTAINS THE ENTIRE ITEM, RDBUF RETURNS TO THE 00224000
- * CALLING PROGRAM. IF THE FIRST DATA BLOCK DOES NOT 00225000
- * CONTAIN THE ENTIRE ITEM, RDBUF MOVES THE DATA BLOCK 00226000
- * TO THE INPUT BUFFER AND READS THE NEXT DATA BLOCK 00227000
- * INTO THE DATA BLOCK BUFFER, MOVES THE REMAINDER OF 00228000
- * THE ITEM TO THE INPUT BUFFER, AND RETURNS TO THE 00229000
- * CALLING PROGRAM. IF THE REMAINDER OF THE 00230000
- * VARIABLE-LENGTH ITEM IS NOT COMPLETELY CONTAINED WITH 00231000
- * THE 800 BYTES OF THE SECOND DATA BLOCK, RDBUF READS 00232000
- * THE NEXT DATA BLOCK TO GET THE REMAINING BYTES. 00233000
- * RDBUF REPEATS THIS PROCEDURE UNTIL THE ENTIRE 00234000
- * VARIABLE-LENGTH ITEM HAS BEEN PLACED IN THE INPUT 00235000
- * BUFFER. IT THEN RETURNS TO THE CALLING PROGRAM. 00236000
- * 00237000
- * FILE ACTIVE: 00238000
- * 00239000
- * IF THE FILE IS ACTIVE, RDBUF DETERMINES WHETHER THE 00240000
- * ITEM TO BE READ IS OF FIXED OR VARIABLE LENGTH. IF 00241000
- * OF FIXED LENGTH, IT PROCEEDS AS DESCRIBED FOR 00242000
- * FIXED-LENGTH ITEMS UNDER "FILE NOT ACTIVE". IF OF 00243000
- * VARIABLE LENGTH AND THE ITEM TO BE READ IMMEDIATELY 00244000
- * FOLLOWS THE ONE JUST READ, RDBUF MOVES THE 00245000
- * VARIABLE-LENGTH ITEM INTO THE INPUT BUFFER IN THE 00246000
- * PREVIOUSLY DESCRIBED MANNER. IF THE VARIABLE-LENGTH 00247000
- * ITEM TO BE READ PRECEDES THE ONE JUST READ, RDBUF 00248000
- * PROCEEDS AS DESCRIBED FOR VARIABLE-LENGTH RECORDS 00249000
- * UNDER "FILE NOT ACTIVE". IF THE VARIABLE-LENGTH ITEM 00250000
- * TO BE READ FOLLOWS, BUT NOT IMMEDIATELY, THE ONE JUST 00251000
- * READ, RDBUF READS FORWARD FROM THE CURRENT LOCATION 00252000
- * IN THE FILE UNTIL IT LOCATES THE DATA BLOCK 00253000
- * CONTAINING THE START OF THE DESIRED ITEM. IT THEN 00254000
- * MOVES THAT ITEM TO THE INPUT BUFFER AS PREVIOUSLY 00255000
- * DESCRIBED. 00256000
- * 00257000
- * NOTES: 00258000
- * 00259000
- * 1. IF FEASIBLE, RDBUF READS ANY PHYSICAL BLOCKS OF 00260000
- * 800 BYTES OR MORE DIRECTLY INTO THE CALLER'S 00261000
- * BUFFER, RATHER THAN INTO A FREE STORAGE BUFFER AND 00262000
- * THEN MOVING THE DATA. FOR EXAMPLE, IF A CALLER 00263000
- * CALLS FOR FORTY 80-BYTE RECORDS, TOTALING 3200 00264000
- * BYTES, RDBUF (WHEN IT HAS THE DATA-BLOCK DISK 00265000
- * ADDRESSES AVAILABLE FROM THE APPROPRIATE CHAIN 00266000
- * LINK) CALLS RDTK TO READ THE 3200 BYTES DIRECTLY 00267000
- * INTO THE CALLER'S BUFFER. THIS PROCEDURE SAVES 00268000
- * CONSIDERABLE PROCESSING, IO'S TO THE DISK, DATA 00269000
- * MOVING, ETC. 00270000
- * 00271000
- * 2. RDBUF, IN ADDITION TO VARIOUS OTHER CHECKING, 00272000
- * CHECKS THE CORE-ADDRESS GIVEN BY THE CALLER. THIS 00273000
- * CORE ADDRESS MUST BE NO LOWER THAN THE BEGINNING 00274000
- * OF FREE STORAGE (FREAR), WITH THE SINGLE EXCEPTION 00275000
- * OF THE STORAGE AREA BLK1, WHICH IS LEGAL FOR 00276000
- * CERTAIN APPLICATIONS. IF THE CORE-ADDRESS IS NOT 00277000
- * ABOVE FREAR OR WITHIN BLK1, AN ERROR CODE 2 IS 00278000
- * GIVEN, AND NO READING OCCURS. THIS SAFEGUARDS THE 00279000
- * CMS NUCLEUS FROM BEING CLOBBERED BY AN INVALID 00280000
- * RDBUF PARAMETER LIST IN ANY PROGRAM. 00281000
- * 00282000
- *. 00283000
- * 3. RDBUF ALSO DETERMINES WHETHER A NULL RECORD HAS BEEN READ 00284000
- * AND INDICATES THIS APPROPRIATELY IN THE PLIST. 00285000
- EJECT 00286000
- DMSBRD START 0 00287000
- RDBUF EQU * 00288000
- ENTRY RDBUF 00289000
- USING NUCON,R0 00290000
- FSENTR REGSAV3 ENTER 'RDBUF' HERE, SAVE REGISTERS... 00291000
- MVI SWS(R13),00 CLEAR SWITCH (USED AS FOLLOWS ...) 00292000
- * BIT 4 = USER BUFFER AREA TOO SMALL IF ON 00293000
- * BIT 5 = VARIABLE ITEM ROUTINES 00294000
- SR R0,R0 MAKE SURE FULLWORD LOCATION TO STORE NO. 00295000
- LA R1,0(,R1) MAKE SURE THE REGISTER IS PRESENTABLE 00296000
- ST R0,READCNT INIT READ CNT TO '0' @V208888 00297000
- ST R0,FALIGN(,R13) AND MAKE SURE 'FALIGN' IS CLEAR. 00298000
- EJECT 00299000
- * 00300000
- ****************************************************** 00301000
- * 00302000
- * CHECK FOR PARAMETER LIST ERRORS 00303000
- * 00304000
- ******************************************************* 00305000
- * 00306000
- C R0,FILNAM(,R1) ARE FIRST 4 BYTES OF FILE ZERO? 00307000
- BE FSTERR YES - AN ERROR IN USER PARAMETER LIST 00308000
- * 00309000
- LM R14,R15,UBUFF(R1) A(USER-BUFFER) INTO R14, 00310000
- LA R14,0(,R14) STRIP OFF HIGH ORDER BYTE 00311000
- AR R15,R14 AND NOW HAVE END-OF-BUFFER IN R15. 00312000
- L R2,=V(TRANSEND) ADDRESS OF START OF NUCLEUS CODE 00313000
- L R3,AUSRAREA ADDRESS OF START OF USER AREA 00314000
- L R4,VMSIZE ADDRESS OF END OF VIRTUAL MEMORY 00315000
- CR R14,R0 READING INTO LOCATION 0 ? 00316000
- BNH ERROR2 YES, ERROR 00317000
- CR R15,R2 READING INTO FREE STORAGE ? 00318000
- BNH UBUFFOK (OR TRANSIENT AREA?) OK IF YES. @VA01246 00319000
- CR R14,R3 READING INTO NUCLEUS CODE ? 00320000
- BL ERROR2 YES, ERROR. V0510 00321000
- CR R15,R4 READING BEYOND END OF MEMORY ? 00322000
- BNH UBUFFOK NO, CONTINUE 00323000
- CLC VMSIZE+1(3),SVCOPSW+5 DCSS USER..??? @VA10561 00323300
- BL UBUFFOK LET HIM BE @VA10561 00323600
- ERROR2 LA R15,2 ERROR 2 IF < FREAR AND NOT IN 'BLK1' 00324000
- B RETURN OR IF END-OF-BUFFER > END-OF-CORE. 00325000
- * 00326000
- UBUFFOK EQU * OK IF USER BUFFER WITHIN BLK1 OR > FREAR & IN CORE 00327000
- LR R11,R1 SAVE R1 IN R11 FOR NOW, 00328000
- L R15,AACTLKP CALL 'ACTLKP' TO LOOK FOR MATCH. 00329000
- BALR R14,R15 (R13 OK AS IS) 00330000
- BZ FOUND1 BZ IF ACTLKP FOUND IT. 00331000
- CLC STATEFST(16),FILNAM(R1) IF NOT, PERHAPS GIVEN BY STATE? 00332000
- BNE RDB01 BNE IF NOT. 00333000
- CLC STATEFST+24(2),PMODE(R1) IF YES, DOES MODE MATCH TOO ? 00334000
- BE RDB02 GOOD SHOW IF YES, STATEFST HAS THE INFO. 00335000
- RDB01 EQU * @VA09734 00335800
- LR R1,R11 RESTORE REG ONE FOR LFS @VA09734 00336100
- L R15,=V(DMSLFS) IF NOT,CALL FSTLKP @VA09734 00336400
- BALR R14,R15 (R13 OK FOR FSTLKP ALSO) 00337000
- BZ ENTFND BZ IF FOUND BY FSTLKP. 00338000
- * 00339000
- FSTERR EQU * NAME NOT FOUND - AN ERROR 00340000
- LA R15,1 ERROR CODE 1 00341000
- B RETURN AND GO EXIT. 00342000
- * 00343000
- * FOUND BY ACTLKP ... 00344000
- FOUND1 LR R3,R1 REFERENCE ACTIVE-FILE-TABLE, 00345000
- USING AFTSECT,R3 ... 00346000
- TM AFTFLG,AFTWRT ACTIVE-WRITE ? 00347000
- LA R15,9 ERROR 9 00348000
- BO RETURN IF YES. 00349000
- LA R5,AFTFST POINT R5 TO COPY OF FST BLOCK IN AFT BLOCK 00350000
- B RDB03 JOIN CODE BELOW. 00351000
- DROP R3 (FOR NOW). 00352000
- EJECT 00353000
- * 00354000
- ************************************************************ 00355000
- * 00356000
- * NOW REGISTER 5 POINTS TO START OF CORRECT TABLE ENTRY 00357000
- * 00358000
- ************************************************************ 00359000
- * 00360000
- RDB02 LM R0,R1,STATER0 LOAD R0-R1 FROM STATEFST AREA. 00361000
- CLC 0(8,R1),FILNAM(R11) OSFST? @V201122 00362000
- BNE RDB01 MUST BE, DO LFS @V201122 00363000
- * 00364000
- ENTFND SR R3,R3 R3=0 MEANS FOUND BY FSTLKP 00365000
- LR R5,R1 REFERENCE FST-BLOCK 00366000
- USING FSTSECT,R5 ... 00367000
- RDB03 EQU * NOTE: R11 HOLDS ORIGINAL R1 (P-LIST POINTER) 00368000
- SR R8,R8 EMPTY A REGISTER. V0510 00369000
- ICM R8,B'0011',HOWMNY(R11) CHECK NO. OF ITEMS. V0510 00370000
- LTR R8,R8 SHOULD BE > 0 (AND NO MORE THAN 32767) 00371000
- LA R15,5 ERROR 5 IF 00372000
- BZ RETURN ¬> 0 V0510 00373000
- C R8,=F'32768' COMPARE WITH MAXIMUM. V0510 00374000
- BH RETURN <¬ 32768 V0510 00375000
- SR R14,R14 EMPTY A REGISTER. V0510 00376000
- ICM R14,B'0011',FSTIC GET NO. ITEMS IN FILE. V0510 00377000
- SR R4,R4 TIP IT OUT. V0510 00378000
- ICM R4,B'0011',ITEM(R11) GET ITEM NUMBER. V0510 00379000
- BNZ CKV USE IT, IF NOT = 0. P0297 00380000
- ICM R4,B'0011',FSTRP USE READ-POINTER FROM FST. V0510 00381000
- CKV CLI FSTFV,C'V' IS IT VARIABLE? P0297 00382000
- BNE CKF MAYBE IT'S FIXED? P0297 00383000
- C R8,ONE IF V, IS NO. OF ITEMS (STILL IN R8) = 1 ? 00384000
- BE CKEOF O.K. P0297 00385000
- LA R15,11 ERROR 11 IF NOT 1 ITEM AT A TIME 00386000
- B RETURN ... P0297 00387000
- CKF CLI FSTFV,C'F' IS IT FIXED? P0297 00388000
- BE CKEOF YES, CHECK ON. P0297 00389000
- LA R15,7 ERROR 7, IF NOT F OR V. P0297 00390000
- B RETURN ... P0297 00391000
- CKEOF CR R4,R14 IS NUMBER BIGGER THAN NO. OF ITEMS? P0297 00392000
- LA R15,12 ERROR 12 (END OF FILE) P0297 00393000
- BH RETURN IF YES, END OF DATA. P0297 00394000
- LTR R3,R3 IS THIS IN ACTIVE TABLE? P0297 00395000
- BP ACTIVE BP IF YES (ALREADY SET UP) 00396000
- DROP R5 00397000
- USING FSCBD,R5 @VA06024 00398000
- EJECT 00399000
- * 00400000
- ************************************************************ 00401000
- * 00402000
- * WE MUST OPEN THE FILE BY LOOKING FOR AN EMPTY 00403000
- * ENTRY IN THE ACTIVE STATUS TABLE AND FILLING 00404000
- * THIS ENTRY WITH INFORMATION ABOUT THE FIRST 00405000
- * CHAIN LINK 00406000
- ************************************************************ 00407000
- * 00408000
- LR R1,R5 RESTORE R1 VALUE FROM FSTLKP, 00409000
- * NOTE: R11 HOLDS ORIGINAL R1 (P-LIST POINTER) FOR ACTFREE 00410000
- L R15,AACTFREE CALL 'ACTFREE' TO DO ALMOST ALL THE WORK 00411000
- BALR R14,R15 ... 00412000
- LR R3,R1 REFERENCE ACTIVE FILE TABLE, 00413000
- USING AFTSECT,R3 ... 00414000
- RDB10 OI AFTFLG,AFTRD SET ACTIVE-READ FLAG-BIT 00415000
- STH R4,AFTRP MAKE SURE READ-POINTER IS CORRECT 00416000
- MVC PLIST+12(4,R13),AFTADT STORE ACTIVE-DISK-TABLE PTR. 00417000
- LA R0,125 GET 125 DOUBLE-WORDS V0510 00418000
- DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR, @VA03665X00419000
- ERR=ERROR25 @VA03665 00420000
- ST R1,AFTFCLA POINT TO THE FCL BUFFER. V0510 00421000
- LR R10,R1 ALSO KEEP IN R10. 00422000
- LA R11,200(,R1) PLUS 200 INTO R11, AND 00423000
- ST R11,AFTDBA STORE CORE-ADDRESS OF 800-BYTE DATA-BLOCK 00424000
- L R5,REGSAV3+4 NOW PLACE ORIGINAL R1 IN R5 (TO STAY) 00425000
- MVC AFTCLD(2),AFTFCL POINT CHAIN LINK PTR TO 00426000
- MVC AFTCLN(2),ONE+2 FIRST CHAIN LINK 00427000
- SR R9,R9 SIGNIFY WE WANT A QUARTER OF A QUARTER 00428000
- ST 9,PLIST+4(,13) OF A TRACK FROM RDTK 00429000
- ST 10,PLIST(,13) PUT CORE MEM ADDR IN RDTK PARAM LIST 00430000
- LA 9,AFTCLD AND ALSO PLACE ADDRESS OF FIRST DISK 00431000
- ST 9,PLIST+8(,13) ADDRESS IN PARAM LIST 00432000
- BAL 9,READ AND READ IN FIRST CHAIN LINK 00433000
- MVC AFTCLB(80),0(10) MOVE IN LINKAGE PART OF 00434000
- * FIRST CH LINK TO THE ACTIVE STATUS TABLE 00435000
- MVC AFTIN(4),ZERO INITIALIZE ITEM NO AND DISPLACEME 00436000
- CLI AFTFV,C'V' IS IT VARIABLE LENGTH ITEMS 00437000
- BE VARSCH YES, FIND LOC. OF ITEM 00438000
- EJECT 00439000
- * 00440000
- ************************************************************ 00441000
- * 00442000
- * ACTIV - THE FILE IS NOW IN ACTIVE STATUS 00443000
- * 00444000
- * GIVE THE USER THE ITEM HE REQUESTED 00445000
- * 00446000
- ************************************************************* 00447000
- * 00448000
- ACTIV EQU * 00449000
- BCTR 4,0 DECREASE ITEM NUMBER BY 1 00450000
- SR R9,R9 ... V0510 00451000
- ICM R9,B'0011',AFTIC GET NO. ITEMS IN FILE. V0510 00452000
- SR 9,4 SUBTRACT FIRST ITEM NO. DESIRED 00453000
- CLM R9,B'0011',HOWMNY(R5) ENOUGH ITEMS? V0510 00454000
- BL *+8 NO, LIMIT REQUESTED NUMBER 00455000
- ICM R9,B'0011',HOWMNY(R5) YES. GIVE ALL. V0510 00456000
- M 8,AFTIL MULTIPLY BY ITEM LENGTH 00457000
- L 2,BUFSIZ(,R5) AND USER BUFFER SIZE IN REG 2 00458000
- LR 7,4 00459000
- L 4,UBUFF(,R5) PTR TO USER BUFFER AREA IN REG 4 00460000
- LA R4,0(,R4) STRIP OFF HIGH ORDER BYTE 00461000
- M 6,AFTIL MULTIPLY BY NO. OF BYTES/ITEM 00462000
- LA 8,800 AND DIVIDE BY RECORD LENGTH 00463000
- DR 6,8 00464000
- * NOW REGISTER 7 HAS THE RELATIVE TRACK 00465000
- * NUMBER AND REGISTER 6 HAS THE LOCATION 00466000
- * OF THE ITEM 00467000
- TM AFTFLG,X'08' IS THERE A DATA-BLOCK IN CORE ? 00468000
- BE CORLNK NO - BRANCH TO READ IT IN 00469000
- CLM 7,B'0011',AFTDBN IS THE CORRECT DATA BLOCK IN COP0992 00470000
- BNE CORLNK NO - GO GET IT 00471000
- MVI FSCBFLG,FSTITAV INDICATE ITEM AVAILABLE @VA06024 00474000
- * 00475000
- * AT THIS POINT, REGISTERS ARE AS FOLLOWS ... 00476000
- * R2 = NO. OF BYTES DESIRED BY USER (USER BUFFER SIZE) 00477000
- * R4 = ADDRESS OF USER CORE-BUFFER (PTR TO USER BUFFER) 00478000
- * R6 = DISPLACEMENT WITHIN BLOCK OF FIRST DATA BYTE 00479000
- * R7 = PHYSICAL BLOCK NUMBER ('TRKNO') 00480000
- * R8 = BUFFER SIZE (E.G. 800, ETC.) 00481000
- * R9 = ITEM-LENGTH (NO OF BYTES ACTUALLY IN ITEM) 00482000
- LR1411 LR R14,R11 SET R14=R11 TO PASS 'BNE JSNEW' TEST... 00483000
- * 00484000
- MVDATA NI AFTFLG,X'FF'-X'08' CLEAR DATA-BLOCK-IN-CORE BIT, 00485000
- LR R0,R6 COMPUTE 'DISPLACEMENT' 00486000
- AR R0,R9 OF 'NEXT RECORD' 00487000
- ST R0,JDISP(,R13) AND SAVE FOR LATER USE. 00488000
- CR R14,R11 DID WE READ INTO FREE STORAGE ? 00489000
- BNE JSNEW BNE IF NOT (DIRECTLY INTO USER-BUF) 00490000
- SR 8,6 GET NO. OF BYTES LEFT IN CURR DATA BLOCK 00491000
- CR 9,8 IS THE ITEM WHOLLY CONTAINED IN THE BUFFER 00492000
- BNH MOVIT BNH IF YES, GO MOVE IT IN. 00493000
- CR 2,8 IS THE USER BUFFER LARGE ENOUGH 00494000
- BNH BUFSML BNH IF 'BUFFER SMALL' BUT DATA WILL FIT 00495000
- ST 9,TEMP(,13) STORE ACTUAL ITEM LENGTH 00496000
- LR 9,8 PUT SIZE OF ITEM IN BLOCK IN CORE IN R9 00497000
- LR R15,R8 BYTE-COUNT READ INTO R15, 00498000
- BAL R8,ITEMK GO UPDATE COUNT AND MOVE THE DATA. 00499000
- LA 8,1(,9) RELOAD REG. 8 00500000
- L 9,TEMP(,13) AND REG 9 00501000
- SR 9,8 UPDATE ITEM LENGTH LEFT TO MOVE 00502000
- AR 4,8 STARTING POINT IN USER AREA 00503000
- SR 2,8 AND SIZE OF USER BUFFER LEFT 00504000
- LAR7 LA R7,1(,R7) UPDATE RELATIVE TRACK NUMBER IN R7, 00505000
- SR66 SR R6,R6 CLEAR R6 TO START AT BEG. OF BLOCK. 00506000
- LA 8,800 RESTORE NO. OF BYTES/QUARTER TRACK 00507000
- B CORLNK1 READ IN SOME MORE ... 00508000
- * 00509000
- * 00510000
- BUFSML LR 9,2 USER AREA TOO SMALL 00511000
- LR R15,R2 BYTE-COUNT READ INTO R15, 00512000
- BAL R8,ITEMK GO UPDATE COUNT AND MOVE THE DATA. 00513000
- B ERROR8 GO SET ERROR 8 - BUFFER TOO SMALL FOR IT 00514000
- * 00515000
- * 00516000
- MOVIT OI AFTFLG,X'08' SET DATA-BLOCK-IN-CORE IF DATA LEFT 00517000
- CR R2,R9 IS USER-BUFFER LARGE ENOUGH FOR ITEM? 00518000
- BL BUFSML BL IF NOT, MOVE IN PART OF ITEM. 00519000
- LR R15,R9 BYTE-COUNT READ INTO R15, 00520000
- BAL R8,ITEMK GO UPDATE COUNT AND MOVE THE DATA. 00521000
- B CLEAR15 GO CLEAR R15 AND EXIT. 00522000
- * 00523000
- * IF WE READ DIRECTLY INTO USER CORE (AT LEAST 800 BYTES) ... 00524000
- JSNEW A R7,JACTNO(,R13) UPDATE NUMBER OF PHYSICAL BLOCKS READ 00525000
- SR R2,R15 UPDATE R2 = NO. OF BYTES TO READ, 00526000
- AR R4,R15 UPDATE R4 = CORE-ADDRESS FOR READING, 00527000
- SR R9,R15 UPDATE R9 = NO. OF BYTES TO READ 00528000
- A R15,READCNT UPDATE COUNT OF BYTES.. @V208888 00529000
- ST R15,READCNT READ THUS FAR. @V208888 00530000
- CR R2,R9 IS R2 < R9 ? 00531000
- BNL CHEK9 BNL IF NOT (NO PROBLEM). 00532000
- LTR R2,R2 IF BUFFER TOO SMALL, IS THERE ANY MORE 00533000
- BP SR66 BP IF YES, CONTINUE READING. 00534000
- ERROR8 LA R15,8 IF THRU, SET ERROR 8 00535000
- B NOERR AND GO COMPUTE CITMDS FOR NEXT TIME. 00536000
- CHEK9 LTR R9,R9 IF REGULAR CASE, ANY LEFT TO READ? 00537000
- BP SR66 BP IF YES, CONTINUE READING. 00538000
- SR R15,R15 IF ALL DONE, CLEAR R15, 00539000
- L R6,JREM(,R13) REMAINDER (IT IS VALID) INTO R6, AND 00540000
- B STHR7 GO STORE NEW 'TRKNO' AND REMAINDER. 00541000
- EJECT 00542000
- ********************************************************************* 00543000
- * 00544000
- * VARIABLE LENGTH ITEM ROUTINES 00545000
- * 00546000
- ********************************************************************* 00547000
- * 00548000
- * SEARCH FOR DESIRED ITEM NUMBER 00549000
- * 00550000
- VARSCH SR 7,7 SET BLOCK NO. = 0 00551000
- MVC AFTIN(2),ONE+2 SET ITEM NO = 1 00552000
- STH R7,AFTID SET DISPLACEMENT = 0 00553000
- BAL R8,DISKRD READ VERY FIRST DATA BLOCK 00554000
- VARLP1 CLC AFTIN(2),AFTRP ARE WE AT READ PLACE 00555000
- BE ALLSET YUP, ALMOST FINISHED 00556000
- VARLP1A LH R6,AFTID GET DISPLACEMENT WITHIN DATA BLOCK 00557000
- C 6,=F'798' IS ITEM LENGTH IN THIS BLOCK 00558000
- BH OVERLP BH IF NOT, ADJUST THINGS 00559000
- BE OVERL3 BE IF LENGTH = LAST 2 BYTES IN BLOCK 00560000
- LA 8,0(6,11) GET LOC. OF ITEM LENGTH 00561000
- MVC ALIGN(2,13),0(8) ALIGN TO HALFWORD BOUNDARY 00562000
- L R15,FALIGN(,R13) GET NEXT ITEM-LENGTH, 00563000
- LA R9,2(R6,R15) ADJUST AS NECESSARY, 00564000
- VARLP2 C R9,EIGHTHD IS ITEM LENGTH < 800? V0510 00565000
- BL INBLCK BL IF YES, IN THIS BLOCK (& IN CORE) 00566000
- SR R8,R8 IF 800 OR MORE, 00567000
- D R8,EIGHTHD DIVIDE BY 800. V0510 00568000
- AR R7,R9 ADD QUOTIENT TO R7, 00569000
- LR R9,R8 REMAINDER INTO R9 FOR STORING SHORTLY 00570000
- BAL R8,DISKRD READ IN THE APPROPRIATE BLOCK. 00571000
- INBLCK STH R9,AFTID STORE NEW DISPLACEMENT (ITEM LENGTH) 00572000
- SR R6,R6 ... V0510 00573000
- ICM R6,B'0011',AFTIN GET ITEMNO FOR INCR. V0510 00574000
- LA 6,1(,6) ... 00575000
- STH 6,AFTIN ... 00576000
- B VARLP1 TEST ITEM NUMBER 00577000
- OVERLP C R6,EIGHTHD FIRST BYTE IN THIS BLOCK? V0510 00578000
- BL WAS799 BL IF OK, IT'S THERE AT 799. 00579000
- ERROR13 LA R15,13 ERROR 13 IF DISPLACEMENT IS 'SICK'. 00580000
- B RETURN (SHOULDN'T HAPPEN IF ALL CODE CORRECT) 00581000
- WAS799 MVC ALIGN(1,R13),799(R11) MOVE IN THE FIRST BYTE 00582000
- LA 7,1(,7) READ NEXT BLOCK 00583000
- BAL R8,DISKRD ... 00584000
- MVC ALIGN+1(1,R13),0(R11) GET SECOND BYTE 00585000
- L R9,FALIGN(,R13) GET NEW ITEM-LENGTH, 00586000
- LA R9,1(,R9) (ADJUST FOR 1-BYTE-LENGTH) 00587000
- B VARLP2 AND CONTINUE. 00588000
- * 00589000
- OVERL3 SR R9,R9 ... V0510 00590000
- ICM R9,B'0011',798(R11) GET NEW ITEM LENGTH. V0510 00591000
- LA 7,1(0,7) GET NEXT BLOCK 00592000
- BAL R8,DISKRD ... 00593000
- B VARLP2 AND CONTINUE. 00594000
- EJECT 00595000
- * 00596000
- ********************************************************************* 00597000
- * 00598000
- * GET VARIABLE LENGTH ITEM LENGTH AND GET DATA 00599000
- * 00600000
- ********************************************************************* 00601000
- * 00602000
- NQALLSET DS 0H 'NOT QUITE' ALL SET, DO WE HAVE A BLOCK IN CORE? 00603000
- TM AFTFLG,X'08' CHECK THE FLAG ... 00604000
- BO ALLSET BO IF FLAG SET, DATA-BLOCK IS THERE. 00605000
- BAL R8,DISKRD READ IN THE DATA BLOCK & WE'RE ALL SET 00606000
- * 00607000
- ALLSET LH 6,AFTID GET DISPLACEMENT 00608000
- L R2,BUFSIZ(,R5) USER-BUFFER-SIZE INTO R2, 00609000
- L R4,UBUFF(,R5) PTR. TO USER BUFFER IN R4, 00610000
- LA R4,0(,R4) STRIP OFF HIGH ORDER BYTE 00611000
- C 6,=F'798' IS EVERYTHING IN THIS BLOCK 00612000
- BH ALS2 BH IF NOT, ADJUST THINGS. 00613000
- BE ALS6 BE IF LENGTH = LAST 2 BYTES IN BLOCK 00614000
- LA R8,0(R6,R11) GET LOC. OF LENGTH 00615000
- MVC ALIGN(2,13),0(8) ... 00616000
- LA 6,2(,6) ADJUST DISPLACEMENT 00617000
- ALS5 L R9,FALIGN(,R13) NEW ITEM-LENGTH INTO R9, 00618000
- LA 8,800 BUFFER SIZE IN REG 8 00619000
- B LR1411 GO SET UP R14 AND MOVE WHATEVER DATA WE HAVE 00620000
- SPACE 1 V0510 00621000
- ALS2 C R6,EIGHTHD IS FIRST BYTE IN THIS BLOCK? V0510 00622000
- BNL ERROR13 BNL IF IT ISN'T (ERROR 13). 00623000
- MVC ALIGN(1,R13),799(R11) MOVE FIRST BYTE 00624000
- LA 7,1(,7) GET NEXT BLOCK 00625000
- BAL R8,DISKRD ... 00626000
- MVC ALIGN+1(1,13),0(11) GET SECOND BYTE 00627000
- LA 6,1 SET DISPLACEMENT = 1 00628000
- B ALS5 SET REGISTERS 00629000
- * 00630000
- ALS6 SR R9,R9 ... V0510 00631000
- ICM R9,B'0011',798(R11) GET NEW ITEM LENGTH. V0510 00632000
- B LAR7 GO SET UP R7, R6, R8, & READ A BLOCK. 00633000
- EJECT 00634000
- ********************************************************************* 00635000
- * 00636000
- * DISK INTERFACE FOR VARIABLE LENGTH ITEM ROUTINES 00637000
- * 00638000
- ********************************************************************* 00639000
- DISKRD OI SWS(13),X'04' SET FLAG 00640000
- B CORLNK2 GO READ A DATA BLOCK INTO FREE STORAGE 00641000
- * (RETURN-ADDRESS IS PRESERVED IN R8) 00642000
- * 00643000
- * 00644000
- DSKRET NI SWS(13),X'FB' RESET FLAG 00645000
- BR R8 RETURN TO CALLER VIA R8 00646000
- EJECT 00647000
- * 00648000
- ************************************************************ 00649000
- * 00650000
- * ACTIVE - THE FILE IS ALREADY LISTED IN THE 00651000
- * ACTIVE STATUS TABLE SO WE MUST PICK UP ITS 00652000
- * ENTRY ADDRESS IN THE AST 00653000
- * 00654000
- ************************************************************ 00655000
- * 00656000
- ACTIVE DS 0H NOTE -- R3 ALREADY POINTS TO THE CORRECT ENTRY 00657000
- TM AFTFLG,AFTRD ACTIVE-READ FLG-BIT SET ? 00658000
- BZ RDB10 BZ IF NOT (MUST BE FROM A 'POINT'). 00659000
- STH R4,AFTRP MAKE SURE READ-POINTER IS CORRECT 00660000
- MVC PLIST+12(4,R13),AFTADT STORE ACTIVE-DISK-TABLE PTR. 00661000
- L R5,REGSAV3+4 NOW PLACE ORIGINAL R1 IN R5 (TO STAY) 00662000
- L 10,AFTCLA LOAD ADDRESS OF CHAIN LINK BUFFER 00663000
- L 11,AFTDBA LOAD ADDRESS OF DATA BUFFER 00664000
- CLI AFTFV,C'V' IS IT VARIABLE LENGTH ITEM 00665000
- BNE ACTIV IF NOT 'V', GO HANDLE FIXED FILE. 00666000
- * 00667000
- * FOR ACTIVE VARIABLE FILE ... 00668000
- LH R7,AFTDBN SET PRESENT DATA BLOCK NO. 00669000
- CLC AFTIN(2),AFTRP ARE WE AT THE READ PLACE ? 00670000
- BE NQALLSET BE IF YES (IF WE HAVE ANYTHING IN CORE) 00671000
- BH VARSCH IF >, START SEARCH FROM BEGINNING 00672000
- TM AFTFLG,X'08' IF <, START FROM PRESENT POSITION 00673000
- BO VARLP1A IF WE HAVE THE BLOCK IN CORE. 00674000
- BAL R8,DISKRD IF NOT, READ IT IN FIRST, 00675000
- B VARLP1A AND THEN WE CAN PROCEED. 00676000
- EJECT 00677000
- * 00678000
- ************************************************************ 00679000
- * 00680000
- * CORLNK - READS IN THE DATA BLOCK AND, IF 00681000
- * NECESSARY, THE CHAIN LINK CONTAINING THE 00682000
- * POINTER TO THE DATA BLOCK WHICH IS NEEDED 00683000
- * TO GIVE THE USER THE ITEM HE REQUESTED 00684000
- * (RETURNS TO EITHER 'MVDATA' OR 'DSKRET') 00685000
- * 00686000
- ************************************************************ 00687000
- * 00688000
- CORLNK EQU * @VA06024 00689000
- MVI FSCBFLG,FSTITAV MAKE SURE FIELD IS INITIALIZED @VA06024 00690000
- LTR R6,R6 AT THE BEGINNING OF PHYSICAL BLK?@VA03023 00691000
- BNZ CORLNK2 BNZ IF NOT, READ INTO FREE STORAGE. 00692000
- * 00693000
- CORLNK1 LR R14,R4 SET R14 FOR CORE-ADDRESS, 00694000
- LR R15,R9 AND R15 FOR ITEM-SIZE 00695000
- CR R2,R9 MAKE SURE BUFFER ISN'T 'TOO SMALL' 00696000
- BNL CORLNK1A BNL IF OK (ADEQUATE SIZE) 00697000
- LR R15,R2 IF R2 <, SUBSTITUTE R2 COUNT. 00698000
- CORLNK1A C R15,EIGHTHD BYTE COUNT <¬ 800? V0510 00699000
- BNL CORLNK3 BNL IF OK, 800 OR MORE. 00700000
- B CORLNK2 INTO FREE STORAGE ... 00701000
- * 00702000
- JCORLNK2 LM R6,R9,REG69(R13) IF NECESSARY, RESTORE 6-9 AND RECOMPUTE 00703000
- * 00704000
- CORLNK2 LR R14,R11 SET TO READ INTO FREE STORAGE 00705000
- LA R15,800 WITH BYTE-COUNT OF 800. 00706000
- * 00707000
- CORLNK3 STM R14,R15,JS1415(R13) SAVE R14 & R15, 00708000
- STM R6,R9,REG69(R13) (SAVE REGS 6 THRU 9) 00709000
- MVC JREM(8,R13),ZERO STORE '0' AND '1' IN JREM & JACTNO 00710000
- STH 7,AFTDBN CHANGE DATA TRACK NO. IN ACTIVE STAT TA 00711000
- LA 6,60 IS POINTER TO DATA BLOCK 00712000
- CR 7,6 IN FIRST CHAIN LINK 00713000
- BNL NOTONE BNL IF 60 OR MORE, NOT IN 1ST C. L. 00714000
- MVC AFTCLD(2),AFTFCL MOVE DISK ADDR AND NO. OF 00715000
- MVC AFTCLN(2),ONE+2 FIRST CH. LINK INTO AST 00716000
- L R10,AFTFCLA GET ADDR OF FCL IN STORAGE. V0510 00717000
- LA R7,40(,R7) POINT TO THE CHAIN LINK ADDRS. V0510 00718000
- LA R8,100 AND INDICATE THEIR NUMBER. V0510 00719000
- B GTDATA REJOIN V0510 00720000
- RDCHL ST 10,PLIST(,13) SET UP RDTK PARAM LIST WITH ADDR. OF 00721000
- LA 9,AFTCLD CORE BUFFER AND ADDRESS OF DISK ADDRESS 00722000
- ST 9,PLIST+8(,13) AND READ IN CHAIN LINK 00723000
- BAL 9,READ 00724000
- RDCHL1 DS 0H @VA01954 00725000
- LM R14,R15,JS1415(R13) RESTORE R14 & R15 AS NEEDED. 00726000
- LINKIN LR R7,R6 REL. LOC OF DATA BLOCK @ @VA01954 00727000
- LA R8,400 SET R8 = 400 IN CASE NOT 1ST C. L. 00728000
- GTDATA SR R8,R7 R8 NOW=MAX. NO. OF CONSEC DISKAD'S FOR RDTK 00729000
- AR R7,R7 DOUBLE R7 FROM BYTES TO HALFWORDS, 00730000
- LA R9,0(R7,R10) R9 = ADDRESS OF 1ST DISK-ADDRESS 00731000
- LH R7,0(,R9) ACTUAL DISK-ADDRESS INTO R7, 00732000
- STH R7,AFTDBD STORE IT IN ACTIVE-STATUS TABLE. 00733000
- STM R14,R15,PLIST(R13) SET UP LOC. & COUNT FOR RDTK, 00734000
- * ALSO STORE START OF DISK-ADDRESSES 00735000
- ST R9,PLIST+8(,R13) IN PARAMETER-LIST FOR RDTK. 00736000
- C R15,EIGHTHD CHECK THE COUNT. V0510 00737000
- BH MULTBLKS NON-SIMPLE IF MORE TO DEAL WI@VA01954 00738000
- LTR R7,R7 IS BLOCK NULL? @VA01954 00739000
- BNZ BALR9 FINE, GO READ IT IN @VA01954 00740000
- SPACE 1 @VA01954 00741000
- * ZERO THE INTERMEDIATE BUFFER @VA01954 00742000
- * FOR THE FOLLOWING INSTRUCTION R14 IS THE ADDRESS, THE INTER- @VA01954 00743000
- * MEDIATE BUFFER; R15 IS THE LENGTH TO BE FILLED; R7 BITS 0-7 @VA01954 00744000
- * ARE THE PAD CHAR, AND BITS 8-31 ARE THE LENGTH OF THE 'FROM' @VA01954 00745000
- * FIELD, SO THE 'FROM' FIELD ADDRESS IN R6 IS IMMATERIAL. @VA01954 00746000
- MVCL R14,R6 NULL, CLEAR TO ZEROES @VA01954 00747000
- MVI FSCBFLG,FSTNOIT TELL HIM IT'S A NULL BLOCK @VA06024 00748000
- B BUFSET GOOD AS REAL I/O @VA01954 00749000
- SPACE 1 @VA01954 00750000
- MULTBLKS DS 0H @VA01954 00751000
- * NOTE -- AT THIS POINT, WE MUST CHECK TO ENSURE THAT ENOUGH 00752000
- * CONSECUTIVELY-STORED DISK-ADDRESSES ARE AVAILABLE IN THE 00753000
- * CHAIN-LINK TO HANDLE THE COUNT SUPPLIED ... 00754000
- SR R14,R14 CLEAR R14 FOR DIVIDE, 00755000
- D R14,EIGHTHD DIVIDE NO. BYTES BY 800. V0510 00756000
- ST R15,JACTNO(,R13) STORE NO. OF 800-BYTE BLOCKS READ. 00757000
- ST R14,JREM(R13) SAVE REMAINDER FOR NOW @VA01954 00758000
- CR R15,R8 ARE ENOUGH BLOCKS AVAIL IN CL@VA01954 00759000
- BNH SETLOOP SURE, SEE THAT THEY ALL EXIST@VA01954 00760000
- ST R8,JACTNO(,R13) STORE NO. OF 800-BYTE CHUNKS READ 00761000
- SR R15,R8 BLOCKS LEFT FOR NEXT CHUNK @VA01954 00762000
- M R14,EIGHTHD BYTES LEFT FOR NEXT CHUNK @VA01954 00763000
- A R15,JREM(R13) PLUS SMALL LEFTOVER @VA01954 00764000
- ST R15,JREM(R13) TOTAL BYTES TO GO @VA01954 00765000
- LR R15,R8 STD REG FOR BLOCKS TO READ @VA01954 00766000
- B ACTBYTE RECALC ACTUAL BYTES TO READ @VA02419 00767000
- SETLOOP LR R8,R15 NUMBER OF BLOCKS TO READ @VA02419 00768000
- ACTBYTE M R14,EIGHTHD CHANGE BACK TO BYTES @VA02419 00769000
- ST R15,PLIST+4(,R13) STORING NEW COUNT IN PLIST 00770000
- SPACE 1 @VA01954 00771000
- * ALL THE DISK ADDRESSES IN THE CHAIN MUST EXIST ! @VA01954 00772000
- SPACE 1 @VA01954 00773000
- BLKLOOP LH R7,0(R9) ACTUAL DATA BLOCK TRACK AD @VA01954 00774000
- LTR R7,R7 DOES THE DATA BLOCK EXIST? @VA01954 00775000
- BZ JCORLNK2 NO, THEN MUST DO INDIVIDUALLY@VA01954 00776000
- LA R9,2(R9) POINT TO NEXT ADDR ANYWAY @VA01954 00777000
- BCT R8,BLKLOOP @VA01954 00778000
- MVC JS1415+4(4,R13),PLIST+4(R13) PREP FOR NEXT GOROU@VA01954 00779000
- * 00780000
- BALR9 EQU * @VA06024 00781000
- OI FSCBFLG,FSTRECAV INDICATE PREV RECORD NULL @VA06024 00782000
- BAL R9,READ READ IN THE DATA BLOCK @VA03023 00783000
- BUFSET LM R6,R9,REG69(R13) BACK TO CHAIN LINK LEVEL @VA01954 00784000
- LM R14,R15,JS1415(R13) R14=ADDRESS & R15=ACTUAL COUNT. 00785000
- TM SWS(13),X'04' TEST FOR VARIABLE LENGTH USE 00786000
- BE MVDATA GIVE ITEM TO USER 00787000
- B DSKRET RETURN TO VARIABLE LENGTH PACKAGE 00788000
- * 00789000
- * 00790000
- NOTONE SR 7,6 CHAIN LINK NO. NOT ONE 00791000
- SR 6,6 GET CHAIN LINK NUMBER MINUS TWO IN REG 7 00792000
- D 6,FORHUN AND REL LOC OF ADDR IN CH. LINK IN REG 6 00793000
- LA 9,2(,7) PUT CHAIN LINK NUMBER IN REG 9 00794000
- CH 9,AFTCLN IS IT ALREADY IN CORE 00795000
- BE LINKIN YES 00796000
- TM AFTFLG,AFTFBA IS THERE AN N'TH CHAIN LINK BUFF? V0510 00797000
- BO BUFOKY ONLY NEED ONE. V0510 00798000
- ST 1,TEMP(,13) AND GET 800 BYTE BUFFER 00799000
- LA R0,100 GET STORAGE FOR CHAIN-LINK BUFFER V0510 00800000
- DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR V0510 00801000
- LTR R15,R15 IF NOT SUCCESSFUL, @VA02374 00802000
- BNZ ERROR25 RETURN 'CANNOT COMPLETE' COD@VA02374 00803000
- OI AFTFLG,AFTFBA SIGNAL WE HAVE AN N'TH CL BUFFER. V0510 00804000
- ST 1,AFTCLA REG 10 AND ACTIVE STATUS 00805000
- L 1,TEMP(,13) TABLE 00806000
- BUFOKY STH 9,AFTCLN UPDATE CHAIN LINK NO. IN ACTIVE STAT TABLE 00807000
- L R10,AFTCLA GET CHAIN LINK BUFFER ADDRESS. V0510 00808000
- SLL 7,1 MULTIPLY CH. LINK NO. -2 BY TWO 00809000
- LH R8,AFTCLB(R7) TO PICK UP TRACK ADDR OF CHAIN LINK 00810000
- STH 8,AFTCLD PUT IT IN ACTIVE STATUS TABLE 00811000
- LTR 8,8 IS IT ZERO 00812000
- BZ CLEARLNK YES - GIVE USER AN ITEM OF ZERO @VA01486 00813000
- * (AND CLEAR THE NTH CHAIN LINK IN STORAGE) 00814000
- LA 9,800 NO - SIGNIFY 800 BYTES ARE TO BE READ BY 00815000
- ST 9,PLIST+4(,13) RDTK BY PLACING IN PARAM LIST 00816000
- B RDCHL LINK IN REG 7 AND READ IT IN 00817000
- * 00818000
- * IF THE LOGICAL RECORD DOES NOT EXIST BECAUSE THE NTH CHAIN LINK 00819000
- * DOES NOT EVEN EXIST, CLEAR THE NTH CHAIN LINK IN STORAGE FIRST: 00820000
- CLEARLNK L R14,AFTCLA R14 = ADDRESS OF NTH CHAIN LINK @VA01486 00821000
- L R15,EIGHTHD R15 = LENGTH @VA01486 00822000
- SR R9,R9 R9 = 0 (R8 IS IMMATERIAL) @VA01486 00823000
- MVCL R14,R8 CLEAR THE NTH CHAIN LINK, @VA01486 00824000
- B RDCHL1 PRETEND WE GOT IT @VA01954 00825000
- * 00826000
- * 00827000
- ************************************************************ 00828000
- * 00829000
- * RETURN -- UPDATES THE READ POINTER IN THE FILE STATUS 00830000
- * TABLE TO POINT TO THE NEXT SEQUENTIAL ITEM AND RETURNS 00831000
- * TO THE USER 00832000
- * 00833000
- ************************************************************ 00834000
- * 00835000
- CLEAR15 SR R15,R15 CLEAR ERROR-CODE IN R15 00836000
- * 00837000
- NOERR L R7,JDISP(,R13) DISPLACEMENT OF NEXT ITEM INTO R7, 00838000
- C R7,EIGHTHD < 800? V0510 00839000
- BL JSTR7 BL IF YES (EASY) 00840000
- NI AFTFLG,X'F7' CLEAR DATA-BLOCK-IN-CORE FLAG-BIT, 00841000
- SR R6,R6 CLEAR R6 FOR DIVIDE, 00842000
- D R6,EIGHTHD DIVIDE BY 800. V0510 00843000
- AH R7,AFTDBN ADD QUOTIENT TO 'TRKNO', 00844000
- STHR7 STH R7,AFTDBN STORE UPDATED VALUE OF TRKNO. 00845000
- LR R7,R6 PUT REMAINDER (FROM R6) INTO R7, 00846000
- JSTR7 STH R7,AFTID STORE REMAINDER (0 TO 799) FOR NEXT TIM 00847000
- SR R7,R7 ... V0510 00848000
- ICM R7,B'0011',AFTRP ADD NO. ITEMS READ. V0510 00849000
- AH 7,HOWMNY(,R5) ADD NO. OF ITEMS READ 00850000
- STH R7,AFTRP 00851000
- * (NOTE -- 'CITMDS' IS ALREADY UP TO DATE) 00852000
- STH 7,AFTIN SAVE ITEM NUMBER 00853000
- * 00854000
- RETURN EQU * @V208888 00855000
- L R1,READCNT @V208888 00856000
- L R5,REGSAV3+4 GET USER PLIST @V208888 00857000
- * THE FOLLOWING TWO INSTRUCTION PREVENT KEY-THRASHING @VA01954 00858000
- C R1,NOBYTE(,R5) IF COUNT ALREADY UPDATED, @V208888 00859000
- BE NOCNT DON'T BOTHER STORING @V208888 00860000
- ST R1,NOBYTE(,R5) OTHERWISE, DO IT @V208888 00861000
- NOCNT EQU * @V208888 00862000
- LM R0,R14,REGSAV3 RESTORE REGISTERS, @V208888 00863000
- LTR R15,R15 SET CONDITION-CODE (FOR CONVENIENCE OF LOADMOD) 00864000
- BR R14 AND EXIT (TO SVCINT OR LOADMOD). 00865000
- ERROR25 LA R15,CODE25 INSUFFICIENT STORAGE TO @VA02374 00866000
- B RETURN COMPLETE READ OPERATION @VA02374 00867000
- EJECT 00868000
- * 00869000
- ************************************************************ 00870000
- * 00871000
- * ITEML - A ROUTINE TO MOVE DATA TO THE USER'S BUFFER AREA 00872000
- * 00873000
- * REGISTER 9 CONTAINS THE NUMBER OF BYTES TO USE MINUS ONE 00874000
- * REGISTER 4 CONTAINS THE STARTING ADDRESS OF THE USER AREA 00875000
- * 00876000
- * RETURN TO THE CALLER IS THROUGH REGISTER 8 00877000
- * 00878000
- * (DOESN'T MOVE ANYTHING IF R9 < 0 -- JAS, 15 JUNE 1967) 00879000
- * 00880000
- ************************************************************ 00881000
- * 00882000
- ITEMK AR R6,R11 IF ENTER HERE, SET UP R6 AS NEEDED. 00883000
- ITEML A R15,READCNT UPDATE COUNT OF BYTES.. @V208888 00884000
- ST R15,READCNT READ THUS FAR. @V208888 00885000
- LA R15,255 NOW SET REGISTER 15 = 255, 00886000
- LA R0,256 AND REGISTER 0 = 256. 00887000
- S R9,ONE NO. OF BYTES TO MOVE LESS 1 @VA01246 00888000
- BM JPUNT DON'T MOVE ANYTHING IF R9 NEGATIVE 00889000
- ST 4,REG4(,13) SAVE REG 4 AND 9 00890000
- ST 9,REG9(,13) ... 00891000
- MVC NOBYTE(4,R5),READCNT UPDAT READ CNT IN USER LIST@V208888 00892000
- TESTFF CR R9,R15 IS THE NO. OF BYTES TO MOVE LESS THAN 256 00893000
- BNH ONCE YES - GO MOVE ALL AT ONCE 00894000
- EX R15,MVC MOVE 256 BYTES AT A TIME @VA01954 00895000
- SR 9,0 DECREASE COUNT OF BYTES TO MOVE 00896000
- AR 4,0 MOVE POINTER IN USER'S BUFFER 00897000
- AR 6,0 AND MOVE POINTER IN CORE BUFFER 00898000
- B TESTFF AND GO CHECK ITEM LENGTH REMAINING 00899000
- ONCE EX R9,MVC MOVE AMOUNT LESS THAN 256 @VA01954 00900000
- L 4,REG4(,13) RESTORE REGISTER 4 AND 9 00901000
- L 9,REG9(,13) ... 00902000
- JPUNT BR 8 AND RETURN TO THE CALLER 00903000
- EJECT 00904000
- * 00905000
- ************************************************************ 00906000
- * 00907000
- * READ - A ROUTINE TO READ A PART OF THE DISK 00908000
- * INTO CORE BY A CALL TO RDTK 00909000
- * 00910000
- ************************************************************ 00911000
- * 00912000
- READ LA 1,PLIST(,13) LOAD ADDR OF RDTK PARAM LIST 00913000
- L R15,ARDTK AND GO TO RDTK 00914000
- BALR 14,15 00915000
- BCR 8,R9 IF OK (C.C. = 0), RETURN TO CALLER 00916000
- CH R15,H25 LACK OF STORAGE @VA02374 00917000
- BE RETURN YES, RETURN THIS INDICATOR @VA02374 00918000
- LA R15,3 ERROR 3 IF PERMANENT DISK ERROR 00919000
- B RETURN GO EXIT. 00920000
- * 00921000
- DROP R12 00922000
- H25 DC H'25' @VA02374 00923000
- EJECT 00924000
- * 00925000
- ********************************************************************* 00926000
- * 00927000
- * FORMATTED PARAMETER LIST (R1, THEN R5) 00928000
- * 00929000
- ********************************************************************* 00930000
- * 00931000
- FILNAM EQU 8 FILE-NAME & FILE&TYPE 00932000
- PMODE EQU 24 MODE OF FILE 00933000
- ITEM EQU 26 ITEM NUMBER DESIRED 00934000
- UBUFF EQU 28 POINTER TO USER BUFFER AREA 00935000
- BUFSIZ EQU 32 SIZE OF USER BUFFER AREA IN BYTES 00936000
- FVFLAG EQU 36 FIXED-VARIABLE FLAG 00937000
- HOWMNY EQU 38 NO OF ITEMS WANTED 00938000
- NOBYTE EQU 40 NO OF BYTES READ (INSERTED BY RDBUF) 00939000
- EJECT 00940000
- FVS 00941000
- FSCBD @VA06024 00942000
- * 00943000
- ********************************************************************* 00944000
- * 00945000
- * FORMATTED SAVE-AREA (R13) 00946000
- * 00947000
- ********************************************************************* 00948000
- * 00949000
- TEMP EQU RWFSTRG-DISK$SEG TWO WORDS OF TEMPORARY STORAGE 00950000
- REG69 EQU TEMP+8 FOUR WORDS TO HOLD CONTENTS OF REG 6 - 9 00951000
- PLIST EQU REG69+16 16 BYTES TO HOLD PARAM. LIST FOR RDTK 00952000
- REG4 EQU PLIST VERY TEMPORARY STORAGE FOR REG 4 00953000
- REG9 EQU PLIST+4 VERY TEMPORARY STORAGE FOR REG 9 00954000
- UNUSED EQU PLIST+16 NO LONGER USED @VA01954 00955000
- SWS EQU UNUSED+6 1 BYTE TO CONTAIN FLAGS @VA01954 00956000
- FALIGN EQU SWS+2 FULL-WORD WITH 'ALIGN' IN RIGHT-END. 00957000
- ALIGN EQU FALIGN+2 HALF-WORD (RIGHT-END OF 'FALIGN') 00958000
- JS1415 EQU ALIGN+2 REGS 14-15 SAVED HERE BY 'CORLNK' 00959000
- JREM EQU JS1415+8 REMAINDER (IF ANY) IF NOT MULT. OF 800 00960000
- JACTNO EQU JREM+4 NO. OF 800-BYTE BLOCKS READ BY CORLNK. 00961000
- JDISP EQU JACTNO+4 REMAINDER FROM (R6+R9)-SIMILAR TO JREM 00962000
- * 00963000
- END$TEMP EQU JDISP+4 END OF TEMPORARY STORAGE. 00964000
- * 00965000
- DMSBRD CSECT 00966000
- * 00967000
- ********************************************************************* 00968000
- * 00969000
- * NUMBERS USED IN RDBUF 00970000
- * 00971000
- ********************************************************************* 00972000
- * 00973000
- * NOTE -- KEEP 'ZERO' AND 'ONE' IN ORDER ... 00974000
- ZERO DC F'0' 00975000
- ONE DC F'1' 00976000
- * 00977000
- FORHUN DC F'400' 00978000
- EIGHTHD DC F'800' V0510 00979000
- * 00980000
- MVC MVC 0(*-*,R4),0(R6) MOVE FROM INTERMED TO UBUFF @VA01954 00981000
- MVC2 MVC 0(*-*,4),0(6) USED TO MOVE LEGIT ITEM TO UBUFF 00982000
- * 00983000
- CODE25 EQU 25 RC=25 - NOT ENOUGH CORE @VA02374 00984000
- * 00985000
- LTORG 00986000
- EJECT 00987000
- AFT 00988000
- NUCON 00989000
- REGEQU 00990000
- FSTB 00991000
- END 00992000
ibm/vm370-lib/cms/dmsbrd.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator