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