BWR TITLE 'DMSBWR (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME: 00004000 * 00005000 * DMSBWR (WRBUF) 00006000 * 00007000 * FUNCTION: 00008000 * 00009000 * TO WRITE ONE OR MORE SUCCESSIVE ITEMS INTO A 00010000 * SPECIFIED DISK FILE. 00011000 * 00012000 * ATTRIBUTES: 00013000 * 00014000 * NUCLEUS RESIDENT, REENTRANT, CALLED BY BALR OR SVC 00015000 * 00016000 * ENTRY POINTS: 00017000 * 00018000 * DMSBWR (WRBUF) 00019000 * 00020000 * ENTRY CONDITIONS: 00021000 * 00022000 * R1 MUST POINT TO WRBUF PARAMETER LIST: 00023000 * PLIST DC CL8'WRBUF' (NOTE-IMMATERIAL IF CALLED BY BALR) 00024000 * DC CL8' ' FILENAME 00025000 * DC CL8' ' FILETYPE 00026000 * DC CL2' ' FILEMODE 00027000 * DC H' ' ITEM NUMBER OF RECORD TO BE WRITTEN 00028000 * DC A( ) ADDRESS OF OUTPUT BUFFER 00029000 * DC F' ' NUMBER OF BYTES TO BE WRITTEN 00030000 * DC CL2' ' F/V FLAG (IN LEFTMOST BYTE) 00031000 * DC H' ' NUMBER OF ITEMS TO BE WRITTEN 00032000 * 00033000 * EXIT CONDITIONS: 00034000 * 00035000 * NORMAL - 00036000 * R15 = 0 (AND CONDITION-CODE = 0) 00037000 * 00038000 * ERROR - 00039000 * R15 NONZERO (AND CONDITION-CODE = 2) 00040000 * 00041000 * ERROR RETURNS: 00042000 * 00043000 * ERROR RETURNS TO CALLER (R15 VALUE AT EXIT): 00044000 * 00045000 * 2. USER MEMORY ADDRESS = 0 00046000 * 00047000 * 4. FIRST CHARACTER MODE ILLEGAL 00048000 * 00049000 * 5. SECOND CHARACTER MODE ILLEGAL 00050000 * 00051000 * 6. ITEM NUMBER + NUMBER OF ITEMS TOO LARGE--WILL NOT FIT 00052000 * IN A HALFWORD 00053000 * 00054000 * 7. ATTEMPT TO SKIP OVER UNWRITTEN VARIABLE-LENGTH ITEM 00055000 * 00056000 * 8. NUMBER OF BYTES NOT SPECIFIED 00057000 * 00058000 * 9. FILE ALREADY ACTIVE FOR READING 00059000 * 00060000 * 10. MAXIMUM NUMBER OF CMS FILES (3400) REACHED 00061000 * 00062000 * 11. F-V FLAG NOT F OR V 00063000 * 00064000 * 12. MODE SY (SYSTEM) OR OTHER READ-ONLY DISK 00065000 * 00066000 * 13. DISK IS FULL (NON-FATAL) 00067000 * 00068000 * 14. NUMBER OF BYTES TO BE WRITTEN IS NOT INTEGRALLY 00069000 * DIVISIBLE BY NUMBER OF ITEMS TO BE WRITTEN 00070000 * 00071000 * 15. LENGTH THIS ITEM NOT SAME AS PREVIOUS 00072000 * 00073000 * 16. CHARACTERISTIC (F-V FLAG) NOT SAME AS PREVIOUS 00074000 * 00075000 * 17. VARIABLE-LENGTH ITEM GREATER THAN 65K BYTES 00076000 * 00077000 * 18. NUMBER OF ITEMS GREATER THAN 1 FOR VARIABLE-LENGTH FILE 00078000 * 00079000 * 19. MAXIMUM NUMBER OF DATA BLOCKS PER FILE (16060) REACHED 00080000 * 00081000 * 20. INVALID CHARACTER(S) IN FILENAME (OF NEW FILE) 00082000 * 00083000 * 21. INVALID CHARACTER(S) IN FILETYPE (OF NEW FILE) 00084000 * 00085000 * 22. VIRTUAL STORAGE CAPACITY EXCEEDED 00086000 * 00087000 * 00088000 * 25. INSUFFICIENT FREE STORAGE AVAILABLE FOR FILE 00089000 * MANAGEMENT CONTROL AREAS. 00090000 * 00090100 * 27. ATTEMPT TO UPDATE VARIABLE LENGTH ITEM WITH ONE OF DIFFERENT 00090200 * LENGTH 00090300 * CALLS TO OTHER ROUTINES: 00091000 * 00092000 * ACTFREE, ACTFRET, ACTLKP, ADTLKP, DISKDIE, FREE, FRET, 00093000 * FSTLKW, KILLEXF, QQTRK, QQTRKX, RDTK, TRKLKP, 00094000 * TRKLKPX, WRTK 00095000 * 00096000 * EXTERNAL REFERENCES: 00097000 * 00098000 * ADT, AFT, FSTB, FVS 00099000 * 00100000 * TABLES/WORKAREAS: 00101000 * 00102000 * SEE EXTERNAL REFERENCES 00103000 * 00104000 * REGISTER USAGE: 00105000 * 00106000 * GRPO - BASE REGISTERS 00107000 * 00108000 * NOTES: 00109000 * 00110000 * NONE 00111000 * 00112000 * OPERATION: 00113000 * 00114000 * WRBUF FIRST PERFORMS A SERIES OF TESTS TO ENSURE THAT 00115000 * THE PARAMETER LIST IS LEGAL. IF IT IS NOT, WRBUF 00116000 * SIGNALS THE ERROR AND RETURNS TO THE CALLING PROGRAM. 00117000 * IF THE PARAMETER IS LEGAL, WRBUF CALLS THE ACTLKP 00118000 * ROUTINE TO SEE IF THE FILE EXISTS AND IS ACTIVE; IF 00119000 * YES, PROCESSING PROCEEDS AS DESCRIBED UNDER "FILE 00120000 * ACTIVE". IF NOT, WRBUF CALLS THE FSTLKW FUNCTION 00121000 * PROGRAM TO DETERMINE WHETHER THE SPECIFIED FILE 00122000 * EXISTS. IF YES, PROCESSING PROCEEDS AS DESCRIBED 00123000 * UNDER "FILE EXISTS, NOT ACTIVE". IF NOT, PROCESSING 00124000 * PROCEEDS AS DESCRIBED UNDER "FILE DOES NOT EXIST". 00125000 * 00126000 * FILE DOES NOT EXIST: 00127000 * 00128000 * IF THE FILE DOES NOT EXIST, WRBUF CALLS ADTLKP TO 00129000 * DETERMINE THE ACTIVE DISK TABLE PERTAINING TO THE 00130000 * GIVEN MODE, AND CHECKS TO ENSURE THAT THE DISK IS 00131000 * AVAILABLE AND IN READ-WRITE STATUS (ERROR RETURN IF 00132000 * NOT). THEN ACTFREE IS CALLED TO OBTAIN AN AVAILABLE 00133000 * SLOT IN THE ACTIVE FILE TABLE FOR THE FILE ABOUT TO 00134000 * BE CREATED. THEN WRBUF INITIALIZES THE AFT ENTRY 00135000 * WITH NECESSARY INFORMATION INCLUDING THE NAME, TYPE, 00136000 * AND MODE OF THE FILE. WRBUF THEN CALLS THE QQTRK 00137000 * ROUTINE TO OBTAIN AN AVAILABLE SIXTEENTH OF A TRACK 00138000 * OF DISK SPACE FOR USE AS THE FIRST CHAIN LINK AND 00139000 * STORES THE DISK ADDRESS RETURNED BY QQTRK IN THE FILE 00140000 * STATUS TABLE. NEXT, WRBUF CALCULATES (FROM THE ITEM 00141000 * NUMBER SUPPLIED IN THE PARAMETER LIST) THE DATA BLOCK 00142000 * INTO WHICH THE ITEM(S) IS/ARE TO BE WRITTEN. THIS 00143000 * CALCULATION ALSO YIELDS THE LOCATION WITHIN THE DATA 00144000 * BLOCK AT WHICH THE ITEM(S) WILL RESIDE. (THE 00145000 * CALCULATION IS ((N-1)*L)/800. N IS THE ITEM NUMBER, L 00146000 * IS THE ITEM LENGTH, AND 800 IS THE LENGTH OF A DATA 00147000 * BLOCK. THE QUOTIENT PRODUCED BY THIS CALCULATION IS 00148000 * THE NUMBER OF THE AFFECTED DATA BLOCK AND THE 00149000 * REMAINDER IS THE DISPLACEMENT INTO THE DATA BLOCK AT 00150000 * WHICH THE ITEM(S) WILL RESIDE.) NEXT, WRBUF 00151000 * CALCULATES THE NUMBER OF BYTES TO BE WRITTEN. THIS 00152000 * IS EQUAL TO THE ITEM LENGTH MULTIPLIED BY THE NUMBER 00153000 * OF ITEMS TO BE WRITTEN. BOTH VALUES ARE OBTAINED 00154000 * FROM THE PARAMETER LIST. WRBUF THEN MARKS THE FILE 00155000 * ACTIVE, OBTAINS BUFFER SPACE FOR THE DATA BLOCK, AND 00156000 * DETERMINES IF THE ITEM TO BE WRITTEN IS OF FIXED OR 00157000 * VARIABLE LENGTH. IF OF VARIABLE LENGTH, PROCESSING 00158000 * PROCEEDS AS DESCRIBED UNDER "VARIABLE-LENGTH ITEM". 00159000 * IF OF FIXED LENGTH, PROCESSING PROCEEDS AS DESCRIBED 00160000 * BELOW. 00161000 * 00162000 * FIXED-LENGTH ITEM: WRBUF DETERMINES THE CHAIN LINK 00163000 * THAT SHOULD CONTAIN THE ADDRESS OF THE AFFECTED DATA 00164000 * BLOCK. (ORDINARILY, AT THIS POINT, THIS WILL BE THE 00165000 * FIRST CHAIN LINK AND IT WILL EXIST IN MAIN STORAGE.) 00166000 * IF THIS CHAIN LINK DOES NOT EXIST (THAT IS, ITS 00167000 * CORRESPONDING ENTRY IN THE FIRST CHAIN LINK IS NOT A 00168000 * VALID DISK ADDRESS), WRBUF CALLS THE TRKLKP FUNCTION 00169000 * PROGRAM TO OBTAIN A QUARTER OF A TRACK FOR THE NEW 00170000 * CHAIN LINK, INSERTS THE DISK ADDRESS RETURNED BY 00171000 * TRKLKP INTO THE CHAIN LINK DIRECTORY OF THE ACTIVE 00172000 * FILE TABLE ENTRY, AND OBTAINS STORAGE FOR USE IN 00173000 * CONSTRUCTING THE NEW CHAIN LINK. IF THE CHAIN LINK 00174000 * EXISTS, WRBUF CALLS THE RDTK FUNCTION PROGRAM TO READ 00175000 * IT INTO MAIN STORAGE. WRBUF THEN DETERMINES IF THE 00176000 * AFFECTED DATA BLOCK EXISTS. (IT WILL IF THE 00177000 * CORRESPONDING ENTRY IN THE CHAIN LINK THAT IS IN MAIN 00178000 * STORAGE CONTAINS A VALID DISK ADDRESS.) IF IT DOES 00179000 * NOT EXIST, WRBUF CALLS THE TRKLKP FUNCTION PROGRAM TO 00180000 * OBTAIN A QUARTER OF A TRACK FOR THE NEW DATA BLOCK, 00181000 * INSERTS THE DISK ADDRESS RETURNED BY TRKLKP INTO THE 00182000 * APPROPRIATE ENTRY IN THE CHAIN LINK THAT IS IN MAIN 00183000 * STORAGE, AND CLEARS THE DATA BLOCK BUFFER FOR USE IN 00184000 * CONSTRUCTING THE DATA BLOCK. IF THE DATA BLOCK 00185000 * EXISTS, WRBUF CALLS THE RDTK FUNCTION PROGRAM TO READ 00186000 * IT INTO THE DATA BLOCK BUFFER. WRBUF THEN CALCULATES 00187000 * THE NUMBER OF BYTES IN THE DATA BLOCK BUFFER THAT ARE 00188000 * AVAILABLE FOR USE. (THE NUMBER OF BYTES AVAILABLE IS 00189000 * EQUAL TO 800 MINUS THE PREVIOUSLY CALCULATED 00190000 * DISPLACEMENT.) NEXT, WRBUF DETERMINES WHETHER THE 00191000 * NUMBER OF BYTES TO BE WRITTEN IS GREATER THAN THE 00192000 * NUMBER OF BYTES AVAILABLE IN THE DATA BLOCK BUFFER. 00193000 * IF THE NUMBER OF BYTES TO BE WRITTEN IS NOT GREATER 00194000 * THAN THE NUMBER AVAILABLE, WRBUF MOVES THE BYTES TO 00195000 * BE WRITTEN FROM THE INPUT BUFFER TO THE BLOCK BUFFER 00196000 * AND RETURNS TO THE CALLING PROGRAM. (IN THIS CASE, 00197000 * THE DATA BLOCK IS NOT WRITTEN ONTO DISK BECAUSE IT IS 00198000 * NOT FULL.) IF THE NUMBER OF BYTES TO BE WRITTEN 00199000 * EXCEEDS THE NUMBER OF BYTES AVAILABLE, WRBUF MOVES 00200000 * SUFFICIENT BYTES INTO THE DATA BLOCK BUFFER TO FILL 00201000 * IT, AND WRITES THE COMPLETED DATA BLOCK ONTO DISK. 00202000 * WRBUF THEN DETERMINES IF THE CHAIN LINK THAT SHOULD 00203000 * CONTAIN THE ADDRESS OF THE DATA BLOCK THAT IS TO 00204000 * RECEIVE THE OVERFLOW FROM THE PREVIOUS DATA BLOCK IS 00205000 * IN MAIN STORAGE. IF IT IS NOT, WRBUF WRITES THE 00206000 * CURRENT CHAIN LINK (THAT IS, THE ONE IN MAIN STORAGE) 00207000 * ONTO DISK AND RETRIEVES THE CHAIN LINK CONTAINING THE 00208000 * ADDRESS OF THE DATA BLOCK THAT IS TO RECEIVE THE 00209000 * OVERFLOW. THIS CHAIN LINK MAY OR MAY NOT EXIST. IF 00210000 * THE CHAIN LINK DOES NOT EXIST, WRBUF ALLOCATES DISK 00211000 * SPACE FOR THE NEW CHAIN LINK IN THE PREVIOUSLY 00212000 * DESCRIBED MANNER AND DETERMINES IF THE DATA BLOCK 00213000 * THAT IS TO RECEIVE THE OVERFLOW EXISTS AS PREVIOUSLY 00214000 * DESCRIBED. IF THE CHAIN LINK EXISTS, WRBUF READS IT 00215000 * INTO MAIN STORAGE AND DETERMINES IF THE DATA BLOCK TO 00216000 * RECEIVE THE OVERFLOW EXISTS. WHEN THE DATA BLOCK 00217000 * THAT IS TO RECEIVE THE OVERFLOW IS IN MAIN STORAGE, 00218000 * (THAT IS, IN THE DATA BLOCK BUFFER) WRBUF CALCULATES 00219000 * THE NUMBER OF BYTES REMAINING TO BE WRITTEN. IF THIS 00220000 * IS NOT GREATER THAN THE NUMBER OF BYTES AVAILABLE IN 00221000 * THE DATA BLOCK BUFFER (ON OVERFLOW, ALL 800 BYTES OF 00222000 * THE DATA BLOCK BUFFER ARE AVAILABLE), WRBUF MOVES THE 00223000 * REMAINING BYTES FROM THE INPUT BUFFER TO THE DATA 00224000 * BLOCK BUFFER AND RETURNS TO THE CALLER. IF THE 00225000 * NUMBER OF BYTES REMAINING TO BE WRITTEN IS GREATER 00226000 * THAN THE NUMBER OF BYTES AVAILABLE IN THE DATA BLOCK 00227000 * BUFFER, WRBUF MOVES SUFFICIENT BYTES INTO THE DATA 00228000 * BLOCK BUFFER TO FILL IT, WRITES THE DATA BLOCK ONTO 00229000 * DISK, AND MOVES THE OVERFLOW INTO THE NEXT DATA BLOCK 00230000 * AS DESCRIBED. 00231000 * 00232000 * VARIABLE-LENGTH ITEM: WRBUF READS SUCCESSIVE DATA 00233000 * BLOCKS (STARTING WITH THE FIRST) INTO THE DATA BLOCK 00234000 * BUFFER UNTIL IT LOCATES THE ONE THAT CONTAINS THE 00235000 * ITEM IMMEDIATELY PRECEDING THE ONE THAT CORRESPONDS 00236000 * TO THE ITEM NUMBER SPECIFIED IN THE PARAMETER LIST. 00237000 * IT THEN LOCATES THE END OF THAT ITEM. (THIS MAY 00238000 * ENTAIL READING ADDITIONAL DATA BLOCKS, DEPENDING ON 00239000 * THE LENGTH OF THE ITEM.) WHEN IT LOCATES THE END OF 00240000 * THE ITEM, WRBUF MOVES THE LENGTH OF THE ITEM TO BE 00241000 * WRITTEN FROM THE INPUT BUFFER TO THE LOCATION IN THE 00242000 * DATA BLOCK BUFFER IMMEDIATELY AFTER THE END OF THE 00243000 * PREVIOUS ITEM. IT THEN MOVES THE ITEM TO BE WRITTEN 00244000 * FROM THE INPUT BUFFER TO THE DATA BLOCK BUFFER IN THE 00245000 * SAME MANNER AS FOR FIXED-LENGTH ITEMS. (IF OVERFLOW 00246000 * OCCURS, IT IS HANDLED IN THE SAME MANNER AS FOR 00247000 * FIXED-LENGTH ITEMS.) 00248000 * 00249000 * FILE EXISTS, NOT ACTIVE: 00250000 * 00251000 * IF THE FILE EXISTS BUT IS NOT ACTIVE, WRBUF 00252000 * CALCULATES THE DATA BLOCK INTO WHICH THE ITEM(S) IS 00253000 * TO BE WRITTEN. THIS CALCULATION ALSO YIELDS THE 00254000 * LOCATION WITHIN THE DATA BLOCK AT WHICH THE ITEM(S) 00255000 * WILL RESIDE. ACTFREE IS CALLED TO OBTAIN AN 00256000 * AVAILABLE SLOT IN THE ACTIVE FILE TABLE AND TO STORE 00257000 * THE FST ENTRY THEREIN. NEXT, WRBUF MARKS THE FILE AS 00258000 * ACTIVE, READS THE FIRST CHAIN LINK INTO MAIN STORAGE, 00259000 * AND MOVES THE FIRST 80 BYTES OF THE FIRST CHAIN LINK 00260000 * INTO THE CHAIN LINK DIRECTORY OF THE ACTIVE FILE 00261000 * TABLE ENTRY. WRBUF THEN DETERMINES IF THE ITEM(S) TO 00262000 * BE WRITTEN ARE OF FIXED OR VARIABLE LENGTH. FOR BOTH 00263000 * OF THESE ITEM TYPES, WRBUF PROCEEDS AS DESCRIBED 00264000 * UNDER THE CORRESPONDING HEADING IN "FILE DOES NOT 00265000 * EXIST" IN THIS SECTION. 00266000 * 00267000 * FILE ACTIVE: 00268000 * 00269000 * IF THE FILE IS ACTIVE, WRBUF CALCULATES THE DATA 00270000 * BLOCK INTO WHICH THE ITEM(S) IS/ARE TO BE WRITTEN. 00271000 * THIS CALCULATION ALSO YIELDS THE DISPLACEMENT INTO 00272000 * THE DATA BLOCK AT WHICH THE ITEM(S) WILL RESIDE. 00273000 * NEXT, WRBUF DETERMINES THE NATURE OF THE ITEM(S) TO 00274000 * BE WRITTEN. IF OF VARIABLE LENGTH, WRBUF PROCEEDS AS 00275000 * DESCRIBED UNDER "VARIABLE-LENGTH ITEM". IF OF FIXED 00276000 * LENGTH, IT PROCEEDS AS DESCRIBED BLOW. 00277000 * 00278000 * FIXED-LENGTH ITEM: WRBUF DETERMINES WHETHER THE 00279000 * AFFECTED DATA BLOCK IS IN MAIN STORAGE. IF IT IS, 00280000 * WRBUF PROCEEDS AS DESCRIBED UNDER "FILE DOES NOT 00281000 * EXIST", STARTING AT THE POINT WHERE THE NUMBER OF 00282000 * BYTES AVAILABLE IN THE DATA BLOCK BUFFER IS 00283000 * CALCULATED. IF THE AFFECTED DATA BLOCK IS NOT IN MAIN 00284000 * STORAGE, WRBUF PROCEEDS IN ESSENTIALLY THE SAME 00285000 * MANNER AS DESCRIBED UNDER "FILE DOES NOT EXIST", 00286000 * STARTING AT THE POINT WHERE THE DATA BLOCK IS WRITTEN 00287000 * ONTO DISK. (IN THIS CASE, AN OVERFLOW CONDITION IS 00288000 * NOT BEING PROCESSED; HOWEVER, THE LOGIC USED TO 00289000 * OBTAIN THE AFFECTED CHAIN LINK AND DATA BLOCK IS 00290000 * ESSENTIALLY THE SAME. ALSO, BECAUSE THIS IS NOT AN 00291000 * OVERFLOW CONDITION, WHEN THE AFFECTED DATA BLOCK IS 00292000 * RESIDENT IN THE DATA BLOCK BUFFER, THE NUMBER OF 00293000 * BYTES AVAILABLE IN THAT BUFFER IS EQUAL TO 800 MINUS 00294000 * THE CALCULATED DISPLACEMENT.) 00295000 * 00296000 * VARIABLE-LENGTH ITEM: IF THE VARIABLE-LENGTH ITEM TO 00297000 * BE WRITTEN IMMEDIATELY FOLLOWS THE ONE THAT WAS JUST 00298000 * PROCESSED, WRBUF MOVES THE ITEM LENGTH FROM THE INPUT 00299000 * BUFFER INTO THE DATA BLOCK BUFFER IMMEDIATELY AFTER 00300000 * THE END OF THE PREVIOUS ITEM. IT THEN MOVES THE ITEM 00301000 * TO BE WRITTEN FROM THE INPUT BUFFER INTO THE DATA 00302000 * BLOCK BUFFER IMMEDIATELY AFTER THE LENGTH. THIS IS 00303000 * DONE IN THE USUAL MANNER. (IF OVERFLOW OCCURS, IT IS 00304000 * HANDLED IN THE USUAL MANNER.) IF THE ITEM TO BE 00305000 * WRITTEN DOES NOT IMMEDIATELY FOLLOW THE ONE THAT WAS 00306000 * JUST PROCESSED, WRBUF PROCEEDS IN THE SAME MANNER AS 00307000 * DESCRIBED UNDER THE VARIABLE-LENGTH ITEM PORTION OF 00308000 * "FILE DOES NOT EXIST". 00309000 * 00310000 * NOTES: 00311000 * 00312000 * 1. WRBUF CAN ONLY WRITE A CERTAIN NUMBER OF LOGICAL 00313000 * RECORDS OR ITEMS, REGARDLESS OF HOW MUCH DISK 00314000 * SPACE MAY BE AVAILABLE, BECAUSE THE "NUMBER OF 00315000 * ITEMS" IS KEPT IN A HALFWORD IN THE 40-BYTE FST 00316000 * ENTRY FOR THAT FILE, AND IS LIMITED BY THE SIZE OF 00317000 * A NUMBER WHICH WILL FIT IN A (16-BIT) HALFWORD. 00318000 * TO AVOID RUNNING INTO THIS LIMITATION BEFORE IT IS 00319000 * TOO LATE TO CLOSE THE FILE SUCCESSFULLY, WRBUF 00320000 * CHECKS THAT THE ITEM-NUMBER (WHEN A WRBUF CALL HAS 00321000 * BEEN COMPLETED) WILL NOT EXCEED A GIVEN LIMIT. IF 00322000 * IT DOES, AN ERROR CODE 6 IS RETURNED, AND NO MORE 00323000 * DATA IS WRITTEN. THE FILE MAY, HOWEVER, AT THIS 00324000 * POINT BE SUCCESSFULLY CLOSED (VIA FINIS), AND CAN 00325000 * LATER BE READ BY RDBUF. AT PRESENT THIS LIMITING 00326000 * NUMBER OF RECORDS HAPPENS TO BE 65533. (65533 00327000 * WOULD HAVE BEEN THE ABSOLUTE LIMITING FACTOR.) 00328000 * 00329000 * 2. IN CALLS TO QQTRK FOR OBTAINING THE FIRST CHAIN 00330000 * LINK FOR A NEW FILE, AND TO TRKLKP FOR OBTAINING 00331000 * EITHER A NEW NTH CHAIN LINK OR A DATA BLOCK, ERROR 00332000 * CODES ARE CHECKED FROM THESE FUNCTION PROGRAMS FOR 00333000 * THE FULL DISK CONDITION. IF ANY OF THESE 00334000 * SITUATIONS OCCUR, WRBUF CAREFULLY SETS OR RESETS 00335000 * ANY FLAGS OR CONDITIONS AS NEEDED, AND PRESENTS 00336000 * THE USER WITH THE NON-FATAL ERROR-CODE 13. 00337000 * THE FILE WHICH WAS BEING WRBUF'ED (UNLESS 00338000 * NULL) IS THEN AVAILABLE AND COMPLETE INSOFAR AS 00339000 * THE DATA BEING WRITTEN COULD FIT IN THE SPACE 00340000 * AVAILABLE. THE DIRECTORY IS NOT UPDATED UNLESS A 00341000 * KX IS IN EFFECT, THUS ALLOWING ANY DESIRED ERROR 00342000 * RECOVERY PROCEDURES TO BE INSTITUTED. 00343000 * 00344000 * 3. BECAUSE OF THE DESIGN OF THE FIRST CHAIN LINK IN 00345000 * THE CMS FILE SYSTEM, THERE IS A LIMITATION OF 00346000 * 16060 800-BYTE DATA BLOCKS FOR ANY GIVEN FILE. IF 00347000 * A FILE BEING WRBUF'ED REACHES THIS LIMIT, AN ERROR 00348000 * 19 IS RETURNED, AND NO MORE DATA IS WRITTEN. THE 00349000 * FILE MAY BE CLOSED, AND CAN THEN BE SUCCESSFULLY 00350000 * READ (OR ERASED), BUT IT CANNOT BE MADE ANY 00351000 * LARGER. (A FILE OF THIS SIZE WOULD FILL MORE THAN 00352000 * HALF OF A FULL-SIZE 2314 DISK). 00353000 * 00354000 * 4. THERE IS ALSO A LIMIT OF 3400 FILES THAT CAN BE 00355000 * REPRESENTED FOR ANY GIVEN DISK, AS LIMITED BY THE 00356000 * LAYOUT OF THE MFD BLOCK. IF A DISK ALREADY HAS 00357000 * REACHED THIS MAXIMUM AND AN ATTEMPT TO WRBUF A NEW 00358000 * FILE IS MADE, WRBUF RETURNS AN ERROR CODE 10, AND 00359000 * THE NEW FILE IS NOT OPENED. 00360000 * 00361000 *. 00362000 EJECT 00363000 DMSBWR START 0 (NOTE - CAN BE CALLED BY BALR WITHIN NUCLEUS) 00364000 ENTRY WRBUF 00365000 WRBUF EQU DMSBWR 00366000 * 00367000 ENTRY INVTBL 00368000 * 00369000 * ENTER 'WRBUF', SAVE REGISTERS, SET UP ADDRESSABILITY, ETC. 00370000 USING NUCON,R0 00371000 L R15,AFVS -- A(FVS) INTO R15 00372000 USING FVSECT,R15 00373000 STM R0,R14,REGSAV3 -- SAVE R0 THRU 14 00374000 DROP R15 00375000 LR R13,R15 -- REFERENCE 'FVS' INFO 00376000 USING FVSECT,R13 00377000 BALR R10,0 -- OUR OWN ADDRESSABILITY 00378000 USING *,R10 00379000 OI UFDBUSY,WRBIT SET OUR BIT IN 'UFDBUSY' FLAG 00380000 LA R1,0(,R1) MAKE THE REGISTER PRESENTABLE 00381000 LM R2,R3,PADDR(R1) CHECK ADDRESS (& BYTE-COUNT INTO R3) 00382000 LR R11,R1 AND MAKE A COPY. V0510 00383000 SR R8,R8 EMPTY A REGISTER. V0510 00384000 ICM R8,B'0011',PNOIT(R1) GET THE NUMBER OF ITEMS. V0510 00385000 LA R2,0(,R2) STRIP OFF HIGH ORDER BYTE. 00386000 LTR 2,2 00387000 LA R15,2 ERROR 2 00388000 BZ ERR IF = 0. 00389000 ST 2,PADDRX SAVE PADDR 00390000 LTR R6,R3 REMEMBER BYTE COUNT, & CHECK IT; @VA01100 00391000 LA R15,8 ERROR 8 IF 00392000 BNP ERR NOT > 0. 00393000 LA R15,0(R2,R3) COMPUTE END OF DATA @VM03232 00394000 C R15,VMSIZE COMPARE WITH VMSIZE @VM03232 00395000 BNH BUFOK GO TO IT @VA10561 00396000 CLC VMSIZE+1(3),SVCOPSW+5 DCSS USER..?? @VA10561 00396200 BH ERROR22 NO KILL HIM (RC=2) @VA10561 00396400 BUFOK EQU * @VA10561 00396600 LA R7,1 1 INTO R7 FOR GENERAL USE (FOR A WHILE) 00397000 SR R0,R0 0 INTO R0, 00398000 ST R0,FALIGN CLEAR 'FALIGN', 00399000 CR R0,R8 PNOIT > 0? V0510 00400000 BL TSTFVF BL IF OK, NO. OF ITEMS IS > 0. 00401000 STH R7,PNOIT(,R1) SET NOIT = 1 (IF IT WAS 0) 00402000 LR R8,R7 READJUST THE SAVED COPY. V0510 00403000 SPACE 1 00404000 TSTFVF EQU * 00405000 CLI PFIVA(1),C'F' TEST F-V 00406000 BE FVF 00407000 CLI PFIVA(1),C'V' 00408000 LA R15,11 ERROR 11 00409000 BNE ERR IF NOT = V. 00410000 CR R7,R8 MUST BE 1 FOR VARIABLE FILES. V0510 00411000 LA R15,18 ERROR 18 00412000 BNE ERR IF NOT = 1. 00413000 C R3,=F'65535' CHECK AGAINST MAX(ALLOWABLE) V0510 00414000 LA R15,17 ERROR 17 00415000 BH ERR IF > 65535. 00416000 FVF CLI PMODE(R1),C'A' MODE LETTER MUST BE SPECIFICALLY GIVEN 00417000 BL ERROR4 ERROR 4 IF < A 00418000 CLI PMODE(R1),C'Z' ... 00419000 BH ERROR4 OR ERROR 4 IF > Z 00420000 CLI PFILE(R1),C'*' ASTERISK IN FILENAME ? @VM03232 00421000 BE ERROR20 THAT'S ILLEGAL ... @VM03232 00422000 CLI PTYPE(R1),C'*' OR ASTERISK IN FILETYPE ? @VM03232 00423000 BE ERROR21 THAT'S IMMORAL OR FATTENING. @VM03232 00424000 LR R3,R8 MAKE A USEFUL COPY OF PNOIT. V0510 00425000 SR R4,R4 ZERO-OUT REGISTER 4 V0510 00426000 ICM R4,B'0011',PITEM(R1) GET THE STARTING ITEM-NUMBV0510 00427000 BZ LR15AA (FORGET IT IF = 0) 00428000 AR R3,R4 COMPUTE ITEM-NUMBER WE WILL HAVE 00429000 C R3,=F'65535' CHECK AGAINST MAX(ALLOWABLE). V0510 00430000 BNL ERROR6 ERROR IF > PRACTICAL LIMIT OF 65533 00431000 LR R3,R8 GET PNOIT. V0510 00432000 LR15AA L R15,AACTLKP GET ADDR OF AFT-LOOKUP. V0510 00433000 BALR R14,R15 (R0 = 0 TO SEARCH FROM BEGINNING) 00434000 BZ FOUND1 BZ IF FOUND BY ACTLKP. 00435000 SR99 SR R9,R9 R9=0 MEANS NOT FOUND BY ACTLKP 00436000 L 15,=V(DMSLFSW) CALL 'FSTLKW', THEN 00437000 BALR 14,15 ... 00438000 LR R12,R1 R1 INTO R12 IN CASE IT WAS SUCCESSFUL, 00439000 BZ FOUND2 BRANCH IF C.C. = 0 (WAS FOUND) @VM03232 00440000 CK LA R1,8(,R11) POINT TO FILE NAME HRC012DS 00441490 BAL R15,PTEST CHECK FILENAME FOR INVALID CHARS @VA01100 00442000 BZ CKTYP FILENAME WAS GOOD, SO HOW WAS FILETYPE 00443000 ERROR20 LA R15,20 TELL HIM HIS FILENAME WAS BAD @VM03232 00444000 B ERR ... 00445000 CKTYP LA R1,16(,R11) POINT TO FILE TYPE HRC012DS 00446490 BAL R15,PTEST CHECK THE FILETYPE. 00447000 BZ PLOK PASSED THIS TEST TOO. 00448000 ERROR21 LA R15,21 TELL HIM HIS FILETYPE WAS BAD @VM03232 00449000 B ERR ... 00450000 PLOK L R2,PADDRX RESTORE WHAT WE CLOBBERED 00451000 LR R1,R11 RESTORE R1 TO PARAMETER-LIST, 00452000 L R15,=V(DMSLAD) CALL 'ADTLKP' TO FIND DISK TO WRITE ON, 00453000 BALR R14,R15 ... 00454000 BNZ ERROR4 ERROR 4 IF NO DISK AT ALL MATCHING THIS LETTER 00455000 CLI PMODE+1(R11),C' ' WAS NO MODE NUMBER SPECIFIED??@VA05746 00456000 BNE CHKMD YES THERE WAS - CHECK IF ILLEGAL @VA05746 00457000 MVI PMODE+1(R11),C'1' DEFAULT MODE NUMBER TO 1 @VA05746 00458000 CHKMD DS 0H @VA05746 00459000 CLI PMODE+1(R11),C'0' IS MODE NUMBER LEGAL? 00460000 BL ERROR5 BRANCH IF NOT 00461000 CLI PMODE+1(R11),C'6' ARE WE SURE? 00462000 BNL ERROR5 BRANCH IF > 5 (NO GOOD) @VA01100 00463000 USING ADTSECT,R1 IF FOUND, REFERENCE ACTIVE-DISK-TABLE, 00464000 TM ADTFLG1,ADTFRW IT BETTER BE A READ-WRITE DISK, 00465000 BZ CANTWRIT ERROR IF IT ISN'T. 00466000 L R0,ADTFSTC TOTAL NO. OF FILES ON THIS DISK 00467000 CH R0,MAXFILES MAXIMUM NO? 00468000 BNL FILSBUST BRANCH IF SO 00469000 LR R0,R1 IF OK, PLACE IN R0 FOR ACTFREE SHORTLY, 00470000 SR R1,R1 AND CLEAR R1 FOR ACTFREE. 00471000 DROP R1 00472000 CLI PFIVA(R11),C'F' FIXED FILE? @VA02521 00473000 BE INIT YES - NO PROBLEM @VA02521 00474000 LA R15,1 VARIABLE-STARTING ITEM NUMBER @VA02521 00475000 CLM R15,B'0011',PITEM(R11) MUST NOT EXCEED 1 @VA02521 00476000 BNL INIT OK IF 0 OR 1 @VA02521 00477000 B ERROR7 ERROR7 IF 2 OR MORE @VA02521 00478000 ERROR5 LA R15,5 ERROR 5 IF MODE NO. < 0 OR > 5. @VA01100 00479000 B ERR ... 00480000 * 00481000 FOUND1 LR R9,R1 REFERENCE ACTIVE-FILE-TABLE, 00482000 USING AFTSECT,R9 ... 00483000 LA R12,AFTFST POINT R12 TO COPY OF FST BLOCK IN AFT BLOCK 00484000 TM AFTFLG,AFTWRT ACTIVE-WRITE ? 00485000 BO FOUND2 BO IF YES (GOOD SHOW), CONTINUE BELOW. 00486000 TM AFTFLG,AFTRD ACTIVE-READ ? 00487000 LA R15,9 ERROR 9 00488000 BO ERR IF YES. 00489000 L R1,AFTADT IF NEITHER (MUST BE FROM A 'POINT'), 00490000 USING ADTSECT,R1 REFERENCE ACTIVE-DISK-TABLE 00491000 TM ADTFLG1,ADTFRW IT BETTER BE A READ-WRITE DISK, 00492000 BZ JCANTWRT MAKE SPECIAL CHECK IF IT ISN'T. 00493000 DROP R1,R9 (FOR NOW) 00494000 * 00495000 USING FSTSECT,R12 (BRIEFLY) 00496000 FOUND2 CLC FSTFV(1),PFIVA(R11) IS CHARACTERISTIC CORRECT 00497000 LA R15,16 ERROR 16 00498000 BNE ERR IF NOT CORRECT 00499000 CLI FSTFV,C'V' IS IT VARIABLE LENGTH ITEM 00500000 BE PROCES YES, DON'T WORRY ABOUT LENGTH 00501000 L R2,FSTIL TEST NO. OF BYTES 00502000 L R15,FSTIL GET ITEM LENGTH V0510 00503000 MR R14,R8 GET SIZE OF REQUEST. V0510 00504000 CR R15,R6 EQUAL TO PNOBY? V0510 00505000 BE PROCES SAME AS BEFORE 00506000 * 00507000 LA R15,15 ERROR 15 IF WRONG 00508000 B ERR NUMBER OF BYTES 00509000 DROP R12 00510000 SPACE 3 00511000 PTEST DS 0H CHECK CHARACTER VALIDITY HRC012DS 00512690 LA R5,7(,R1) PNT AT LAST BYTE OF NAME HRC012DS 00513380 LR R0,R1 SAVE POINTER BEFORE TRT HRC012DS 00514070 TRT 0(8,R1),INVTBL CHECK FOR INVALID CHARACTER HRC012DS 00514760 BZR R15 IF ALL OK, EXIT WITH CC = 0. HRC012DS 00515450 CR R0,R1 DID TRT ERROR AT FIRST CHAR HRC012DS 00516140 BE SETCODE ERROR ON FIRST CHARACTER HRC012DS 00516830 SR R5,R1 CHECK IF FIRST CHAR INVALID HRC012DS 00517520 * SIZE IS -1 FOR EXECUTE INST HRC012DS 00518210 BMR R15 TSK! TSK! BAD LIST HRC012DS 00518900 EX R5,CLC CHECK THE REST FOR BLANKS HRC012DS 00519590 BR R15 EXIT WITH CC SET 0 OR ¬0 HRC012DS 00520280 SETCODE DS 0H SET A NON ZERO CONDITION CODE HRC012DS 00520970 CR R15,R1 R15 = RETURN, R1 = PRAM LIST HRC012DS 00521660 BR R15 RETURN TO CALLER WITH CC = 2 HRC012DS 00522350 CLC CLC 0(0,R1),INVTBL CHECK FOR BLANKS IN NAME HRC012DS 00523040 EJECT 00525000 ******************************************************* 00526000 * 00527000 * OPEN NEW FILE WITH SPECIFIED FILE NAME, FILE TYPE. 00528000 * ASSIGN ENTRY IN ACTIVE STATUS TABLE AND ASSIGN FIRST 00529000 * CHAIN LINK. 00530000 * 00531000 **************************************************** 00532000 * 00533000 * NOTE : R11 ALREADY POINTS TO ORIGINAL P-LIST 00534000 * (NEEDED BY 'ACTFREE') 00535000 * 00536000 INIT L R15,AACTFREE CALL 'ACTFREE' TO OPEN THE FILE 00537000 BALR R14,R15 ... 00538000 LR R9,R1 REFERENCE ACTIVE-FILE-TABLE 00539000 USING AFTSECT,R9 ... 00540000 MVC AFTN(16),PFILE(R11) MOVE IN FILENAME & FILETYPE 00541000 XC AFTD(24),AFTD CLEAR FROM DATE THRU TO END OF 40-BYTES 00542000 MVC AFTFV(1),PFIVA(R11) CHARACTERISTIC 00543000 MVC AFTM(2),PMODE(R11) MODE, 00544000 STH R7,AFTWP SET WRITE- AND 00545000 STH R7,AFTRP READ-POINTERS TO 1 00546000 LR R15,R6 GET PNOBY. V0510 00547000 SR 14,14 ... 00548000 DR R14,R3 CALCULATE INDIVIDUAL ITEM LENGTH 00549000 LTR R15,R15 IS IT GREATER THAN ZERO? @VA04192 00550000 BNP ERROR14 NO - ERROR @VA04192 00551000 LTR R14,R14 WAS THERE A REMAINDER? @VA04192 00552000 BZ SETITEM NO - ITEM LENGTH IS OK @VA04192 00553000 ERROR14 LA R15,14 BUFFER SIZE NOT INTEGRALLY @VA04192 00554000 B ERR DIVISIBLE BY # RECORDS TO WRITE @VA04192 00555000 SETITEM ST R15,AFTIL SET ITEM LENGTH @VA04192 00556000 STH R4,AFTIC STORE ITEM NO. (IF ANY) - STILL IN R4 00557000 LR R1,R0 R1 MUST POINT TO ACTIVE DISK TABLE, 00558000 LR R12,R1 REMEMBER ADDR ACTIVE DISK TABLE @VA01247 00559000 L R15,AQQTRK AND CALL 'QQTRK' 00560000 BALR R14,R15 TO OBTAIN FIRST CHAIN LINK 00561000 BNZ QQBAD BAD NEWS IF ERROR FROM QQTRK 00562000 STH R1,AFTFCL IF OK, RECORD DISK-ADD. OF 1ST CHAIN-LINK 00563000 MVI AFTFLG2,AFTNEW FLAG AS TOTALLY NEW FILE. V0510 00564000 USING ADTSECT,R12 REFERENCE ACTIVE DISK TABLE @VA01247 00565000 L R15,ADTFSTC TOTAL NO. OF FILES ON THIS DISK @VA01247 00566000 AR R15,R7 BUMP COUNT BY 1 (R7 STILL = 1) @VA01247 00567000 ST R15,ADTFSTC AND STORE NEW VALUE @VA01247 00568000 DROP R12 @VA01247 00569000 LA R12,AFTFST POINT R12 TO COPY OF FST BLOCK IN AFT BLOCK 00570000 * CONTINUE TO 'PROCES' ... 00571000 EJECT 00572000 *************************************************** 00573000 * THE POSITION OF THE ITEM IN THE DATA BLOCK IS CALCULATED 00574000 * IF THE CURRENT CHAIN LINK AND DATA BLOCK ARE CURRENTLY 00575000 * IN CORE, THE ITEM IS INSERTED IN THE DATA BLOCK AND WRBUF 00576000 * RETURNS TO THE CALLING ROUTINE. IF A DIFFERENT DATA BLOCK 00577000 * OR CHAIN LINK ARE REQUIRED, THE SECTIONS OF CODE 00578000 * FOLLOWING THIS SECTION ARE REQUIRED. 00579000 * 00580000 **************************************************** 00581000 * 00582000 USING FSTSECT,R12 (FOR A WHILE) 00583000 PROCES LTR R4,R4 IS ITEM-NUMBER SUPPLIED IN P-LIST ? 00584000 BP LR34 BP IF YES, USE IT. 00585000 SR R4,R4 EMPTY OUT A REGISTER. V0510 00586000 ICM R4,B'0011',FSTWP GET THE WRITE-POINTER. V0510 00587000 AR R3,R4 TEST FOR TOO MANY ITEMS 00588000 C R3,=F'65535' CHECK AGAINST THE MAXIMUM V0510 00589000 BL LR34 TRF IF OK - NO MORE THAN 65533. 00590000 ERROR6 LA R15,6 ERROR 6 IF MORE ITEMS TO BE IN A FILE 00591000 B ERR THAN CAN FIT INTO A HALFWORD COUNTER ! 00592000 * 00593000 LR34 LR R3,R4 CALCULATE BLOCK 00594000 BCTR 3,0 NO. AND BYTE NO. 00595000 M R2,FSTIL WITHIN BLOCK 00596000 D R2,EIGHTHD BLOCKNO IN 3; BYTENO IN 2. V0510 00597000 L R15,FSTIL GET NO. BYTES TO BE WRITTEN. V0510 00598000 MR R14,R8 MULTIPLY BY THE NUMBER OF ITEMS. V0510 00599000 LR R5,R15 PUT PRODUCT INTO R5. V0510 00600000 DROP R12 00601000 LTR R9,R9 DO WE NEED TO GET AN ACTIVE TABLE ENTRY ? 00602000 BP SETWR BP IF WE'VE ALREADY GOT ONE. 00603000 L R15,AACTFREE IF NOT, CALL ACTFREE 00604000 BALR R14,R15 (R0 & R1 ARE STILL SET FROM FSTLKW) 00605000 LR R9,R1 REFERENCE ACTIVE FILE TABLE VIA R9, 00606000 * 00607000 SETWR L R12,AFTADT REFERENCE ACTIVE DISK TABLE 00608000 ST R12,PLIST+12 STORE IN RDTK/WRTK P-LIST 00609000 STH R4,AFTWP STORE WRITE-POINTER 00610000 NI AFTFLG2,255-SAMELEN INITIALIZE SAME LENGTH @VA09491 00610500 TM AFTFLG,AFTWRT IS IT ALREADY AN ACTIVE-WRITE ? 00611000 BO INSERT BO IF YES, GET ON WITH IT. 00612000 OI AFTFLG,AFTWRT IT'S AN ACTIVE WRITE NOW, CONTINUE... 00613000 LA R0,125 GET 1000 BYTES OF FREE STORAGE. V0510 00614000 DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR, @VA03665X00615000 ERR=ERROR25P @VA03665 00616000 USING ADTSECT,R12 @VA03665 00617000 LH R15,ADTNACW INCREMENT NUMBER OF ACTIVE @VA03665 00618000 AR R15,R7 WRITE FILES BY 1 @VA03665 00619000 STH R15,ADTNACW AND STORE NEW VALUE @VA03665 00620000 SR R14,R14 ZERO FOR DIVIDE @VA04916 00621000 D R14,=F'20' (20 FST'S PER HYPERBLOCK) @VA04916 00622000 LTR R14,R14 ANY REMAINDER? @VA04916 00623000 BP RESOK YES; SKIP @VA04916 00624000 LH R14,ADTRES NO; INCREMENT RESERVE COUNT @VA04916 00625000 LA R14,2(,R14) BY 2 (DISK MAY BE UPDATED TWICE) @VA04916 00626000 STH R14,ADTRES AND RESTORE IT @VA04916 00627000 DROP R12 @VA04916 00628000 RESOK ST R1,AFTFCLA SAVE ADDRESS OF THE FCL BUFFER @VA04916 00629000 LR R6,R1 WE'LL NEED THIS LATER. V0510 00630000 XC 0(200,R1),0(R1) ZERO-OUT THE FCL IN STORAGE. V0510 00631000 LA R1,200(,R1) DATA BUFFER IS 200 BYTES BEYOND. V0510 00632000 ST R1,AFTDBA SAVE ADDR OF DATA-BLOCK BUFFER. V0510 00633000 TM AFTFLG2,AFTNEW IS THIS A NEW FILE? V0510 00634000 BO RESET ALREADY DONE, IF SO. V0510 00635000 SR R7,R7 SIGNAL READING AN FCL. V0510 00636000 LA R8,AFTFCL POINT TO THE DISK ADDR REQUIRED. V0510 00637000 BAL R14,FSRD1 READ IT IN. V0510 00638000 BNZ ERROR3 BETTER TO QUIT IF ERROR. V0510 00639000 RESET MVC AFTCLB(80),0(6) MOVE CL DISK ADDRS TO AFT V0510 00640000 MVC AFTCLN(2),ONEH SIGNAL THIS IS THE FCL. V0510 00641000 MVC AFTCLD(2),AFTFCL SET DISK ADDR OF FCL. V0510 00642000 CLI AFTFV,C'V' IS IT A VARIABLE LENGTH ITEM? V0510 00643000 BE VARINT YES. INITIALIZE THE FILE. V0510 00644000 FINDBLOK BAL R14,DISKRD FIND THE RIGHT DATA BLOCK, @VM03232 00645000 B INSRT AND GO INSERT THE RECORD(S). @VM03232 00646000 INSERT DS 0H NOTE -- R9 NOW ALREADY POINTS TO RIGHT ACTIVE-TABLE 00647000 CLI AFTFV,C'V' IS IT VARIABLE LENGTH ITEM 00648000 BE VARINS YES - INSERT ITEM @VM03232 00649000 TM AFTFLG,AFTDBF IS THERE A DATA BLOCK IN STORAGE?@VM03232 00650000 BZ FINDBLOK IF NOT, GO FIND THE RIGHT BLOCK. @VM03232 00651000 LH R6,AFTDBN YES - GET "DATA BLOCK NUMBER", @VM03232 00652000 CR R6,R3 DOES IT CONTAIN THIS RECORD ? @VM03232 00653000 BE INSRT YES - GO INSERT THE RECORD(S). @VM03232 00654000 WRITEBLK BAL R14,DISKRW NO - WRITE CURRENT BLOCK FIRST @VM03232 00655000 * INSERT GIVEN RECORD(S) IN DATA BLOCK (AND WRITE IT OUT IF FULL): 00656000 * NOTE: R2 = DISPLACEMENT OF RECORD; R5 = NO. OF BYTES TO BE WRITTEN 00657000 INSRT L R8,PADDRX GET ADDR. OF DATA TO BE WRITTEN @VM03232 00658000 LTR R2,R2 START ON A BLOCK BOUNDARY ? @VM03232 00659000 BNZ RESL NOPE - MUST MOVE THE DATA ETC. @VM03232 00660000 C R5,EIGHTHD IF YES, BLOCK COUNT 800 OR MORE? @VM03232 00661000 BNL LARGEBLK YES - WRITE FORTHWITH. @VM03232 00662000 * HANDLE GENERAL CASE OF SMALL AND/OR UNALIGNED LOGICAL RECORD: 00663000 RESL OI AFTFLG,AFTDBF SIGNAL DATA BLOCK IS IN STORAGE @VM03232 00664000 L R0,AFTDBA GET ADDRESS OF DATA BLOCK @VM03232 00665000 AR R0,R2 ADDRESS OF WHERE TO MOVE TO @VM03232 00666000 LR R14,R8 WHERE TO MOVE FROM @VM03232 00667000 LA R6,Q800 CALCULATE SPACE REMAINING @VM03232 00668000 SR R6,R2 IN THE BLOCK @VM03232 00669000 CR R6,R5 WILL THE RECORD FIT IN THE @VM03232 00670000 * BLOCK ? 00671000 BNL PUTEX YES - PUT IT IN THE BLOCK AND @VM03232 00672000 * EXIT. 00673000 * RECORD WILL NOT FIT IN DATA BLOCK: 00674000 LR R1,R6 SET BYTE COUNT TO WHAT WILL FIT @VM03232 00675000 LR R15,R6 ... @VM03232 00676000 MVCL R0,R14 MOVE WHAT WE CAN @VM03232 00677000 AR R8,R6 BUMP ADDRESS BY NO. BYTES WRITTEN@VM03232 00678000 ST R8,PADDRX REMEMBER FOR LATER, @VM03232 00679000 SR R5,R6 SIMILARLY DECREMENT COUNT @VM03232 00680000 SR R2,R2 R2=0 MEANS START AT BEGIN OF BLK @VM03232 00681000 A R3,ONE BUMP DISK "BLOCK" NUMBER @VM03232 00682000 B WRITEBLK GO WRITE OUT FILLED-UP BLOCK. @VM03232 00683000 SPACE 00684000 LARGEBLK EQU * LARGE BLOCK (800 BYTES OR MORE) @VM03232 00685000 * R2 = DISPLACEMENT = 0 00686000 * R3 = "BLOCK NUMBER" (0 UP) 00687000 * R5 = BYTE COUNT = 800 OR MORE 00688000 * R8 = ADDRESS OF DATA TO BE WRITTEN 00689000 NI AFTFLG,FF-AFTDBF SIGNAL "NO DATA BLOCK EXISTS" @VM03232 00690000 ST R2,AFTDBD ALSO CLEAR AFTDBD (AND AFTDBN) @VM03232 00691000 ST R8,PLIST STORE STARTING DATA-ADDRESS @VM03232 00692000 LR R7,R3 GET "BLOCK NUMBER" (0 UP) @VM03232 00693000 SH R7,SIXTY LESS SIXTY @VM03232 00694000 BM LARGEB1 BRANCH IF BLK NO. WAS 0-59 @VM03232 00695000 SR R6,R6 IF 60 OR MORE, DIVIDE @VM03232 00696000 D R6,FOURHD BY 400 TO GET C.L. OFFSET @VM03232 00697000 LA R7,Q798 SET LIMIT FOR END OF CHAIN LINK @VM03232 00698000 L R2,AFTCLA GET ADDRESS OF NTH CHAIN LINK, @VM03232 00699000 B LARGEB2 BRANCH TO COMMON CODE BELOW. @VM03232 00700000 LARGEB1 LR R6,R3 GET BLOCK NUMBER AGAIN (0-59) @VM03232 00701000 LA R7,Q118 SET LIMIT FOR END OF CHAIN LINK @VM03232 00702000 L R2,AFTFCLA GET ADDRESS OF FIRST CHAIN LINK @VM03232 00703000 LA R2,Q80(,R2) PLUS OFFSET TO POINT TO DATA BLKS@VM03232 00704000 LARGEB2 AR R6,R6 DOUBLE THE CHAIN LINK OFFSET @VM03232 00705000 AR R7,R2 COMPUTE ADDRESS OF CHAIN LINK END@VM03232 00706000 AR R2,R6 COMPUTE WHERE WE WILL START @VM03232 00707000 ST R2,PLIST+8 STORE IN WRTK P-LIST @VM03232 00708000 LA R6,2 R6=2 FOR BXLE USE @VM03232 00709000 * "GETBLOCK" LOOP TO OBTAIN DISK BLOCKS ON WHICH TO WRITE THE DATA: 00710000 LARGEB3 A R3,ONE INCREMENT "BLOCK NUMBER" @VM03232 00711000 SR R15,R15 CLEAR R15 PLEASE, @VM03232 00712000 CH R15,0(,R2) CHECK FOR PRE-EXISTING BLOCK @VM03232 00713000 BNE LARGEB4 IF SOMETHING THERE, USE IT @VM03232 00714000 BAL R14,GETBLOCK IF NOT, GET A NEW BLOCK @VM03232 00715000 BNZ LARGEB5 BEWARE OF FULL DISK @VM03232 00716000 STH R1,0(,R2) OK - STORE NEW BLOCK DISK ADDR @VM03232 00717000 LH R14,AFTDBC INCREMENT DATA-BLOCK-COUNT @VM03232 00718000 LA R14,1(,R14) ... @VM03232 00719000 STH R14,AFTDBC ... @VM03232 00720000 LARGEB4 LA R14,Q800 NEED PHYSICAL BLOCK LENGTH, @VM03232 00721000 AR R8,R14 BUMP DATA-BLOCK ADDRESS @VM03232 00722000 SR R5,R14 DECREMENT BYTE COUNT @VM03232 00723000 CR R5,R14 AT LEAST 800 BYTES LEFT ? @VM03232 00724000 BL LARGEB6 IF NOT, GO WRITE. @VM03232 00725000 BXLE R2,R6,LARGEB3 ITERATE "GETBLOCK" LOOP ... @VM03232 00726000 B LARGEB6 NO ROOM LEFT IN CHAIN LINK. @VM03232 00727000 SPACE 00728000 * ERROR FROM DMKTRK (TRKLKP) TRYING TO GET A BLOCK ON DISK: 00729000 LARGEB5 BAL R14,GIVEBACK GIVE BACK BLOCK WE WON'T USE @VM03232 00730000 LA R15,4 REMEMBER ERROR 4 FROM TRKLKP @VM03232 00731000 BCTR R3,0 ALSO DECREMENT R3 BLOCK NUMBER @VM03232 00732000 SPACE 00733000 * NO MORE ROOM IN CHAIN LINK OR WE HAVE ALL THE BLOCKS WE NEED: 00734000 LARGEB6 STH R3,AFTDBN KEEP "AFTDBN" CURRENT @VM03232 00735000 LR R2,R15 REMEMBER TRKLKP RETURN CODE @VM03232 00736000 LR R1,R8 ACCUMULATED ADDRESS INTO R1, @VM03232 00737000 S R1,PLIST COMPUTE ACCUMULATED BYTE-COUNT, @VM03232 00738000 BNP LARGEB7 BEWARE NO BLOCKS WRITTEN AT ALL, @VM03232 00739000 ST R1,PLIST+4 OK - STORE IN WRTK PLIST @VM03232 00740000 LA R1,PLIST POINT TO WRTK P-LIST, @VM03232 00741000 L R15,AWRTK GET ADDRESS OF WRTK @VM03232 00742000 BALR R14,R15 WRITE OUT THE BLOCK(S) @VM03232 00743000 BNZ ERROR3 VERY DISAPPOINTING IF WRTK ERROR @VM03232 00744000 * NOW CHECK TO SEE IF WE HAVE ANY MORE TO DO ... 00745000 LARGEB7 LTR R2,R2 CHECK TRKLKP RETURN CODE @VM03232 00746000 BNZ WRCHECK IF NOT 0, USE DISK-IS-FULL LOGIC @VM03232 00747000 * CONTINUE IF R2 (BYTE DISPLACEMENT) = 0: 00748000 LTR R0,R5 CHECK REMAINING BYTE COUNT R5/R0 @VM03232 00749000 BZ UPDPT IF NOTHING LEFT, GO FINISH UP. @VM03232 00750000 ST R8,PADDRX PRESERVE R8 (DATA ADDRESS) @VM03232 00751000 B FINDBLOK GO CALL DISKRD & GO TO INSRT. @VM03232 00752000 SPACE 00753000 * RECORD WILL FIT IN DATA BLOCK: 00754000 PUTEX LR R1,R5 BYTE COUNT @VM03232 00755000 LR R15,R5 ... @VM03232 00756000 MVCL R0,R14 MOVE RECORD TO FREE STORAGE BLK @VM03232 00757000 * NOTE: R0 POINTS TO END OF RECORD 00758000 S R0,AFTDBA MAKE RELATIVE TO DATA BLOCK @VM03232 00759000 UPDPT EQU * FINISH UP AND GET OUT OF HERE: @VM03232 00760000 STH R0,AFTID AND STORE ITEM DISPLACEMENT @VM03232 00761000 SR R6,R6 TIP OVER A REGISTER. V0510 00762000 ICM R6,B'0011',AFTWP GET THE WRITE-POINTER. V0510 00763000 AH 6,PNOIT(0,11) UPDATE WRITE POINTER 00764000 STH R6,AFTWP 00765000 STH 6,AFTIN STORE ITEM NUMBER 00766000 BCTR 6,0 NO. OF ITEMS = WRITE POINTER - 1 00767000 CLM R6,M3,AFTIC IS WRITE-PTR > NO. OF ITEMS? @VA07151 00768000 BNH CLIV BNH IF NOT. 00769000 STH R6,AFTIC YES, SET NEW NO. ITEMS COUNT 00770000 CLIV CLI AFTFV,C'V' IS IT VARIABLE LENGTH ? 00771000 BNE LMREG NO, NO NEED TO UPDATE LENGTH 00772000 L R15,PNOBY(,R11) GET LENGTH OF THIS RECORD @VM03232 00773000 CL R15,AFTIL IS THIS RECORD THE LONGEST YET ? @VM03232 00774000 BNH LMREG NO - GO RESTORE REGISTERS @VM03232 00775000 ST R15,AFTIL STORE NEW LONGEST ITEM LENGTH @VM03232 00776000 LMREG SR R15,R15 CLEAR REGISTER 15 FOR SUCCESSFUL RETURN 00777000 * 00778000 ERR KXCHK WRBIT CHECK FOR 'KX' WANTED... 00779000 LTR R13,R13 HAS CHAIN LINK BEEN WRITTEN ? 00780000 BM WRBEX3 TRF IF YES - HANDLE SPECIALLY. 00781000 WRBEX1 LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00782000 WRBEX2 LM R0,R14,REGSAV3 RESTORE REGISTERS R0-R14 00783000 BR R14 AND RETURN TO CALLER. 00784000 SPACE 1 00785000 WRBEX3 LR R3,R15 REMEMBER THE RETURN-CODE IN R3; @VA01100 00786000 L R2,AFTADT NEED ADDR OF ADT FOR THIS DISK @VA01100 00787000 MOVEREGS MVC REGSAV4(60),REGSAV3 AVOID REGSAVING PROBLEMS. V0510 00788000 LR R0,R2 POINT TO THE ADT. V0510 00789000 SR R1,R1 SIGNAL JUST TFINIS. V0510 00790000 L R15,ATFINIS GET THE ADDR OF TFINIS. V0510 00791000 BALR R14,R15 GO THERE. V0510 00792000 SR R1,R1 SIGNAL WE WANT TO RESERVE BLOCKS. V0510 00793000 L R15,AUPDISK GET THE ADDR OF UPDISK. V0510 00794000 BALR R14,R15 GO THERE. V0510 00795000 MVC REGSAV3(60),REGSAV4 REAVOID REGSAVING PROBLEMS V0510 00796000 LR R1,R2 R1 MUST POINT TO THE ADT @VA01100 00797000 SR R0,R0 GET REASSIGNED NTH CHAIN LINK @VA01100 00798000 ICM R0,B'0011',AFTCLDX ... (IS THERE ONE?) @VA01100 00799000 BZ NOCLDX APPARENTLY NOT. V0510 00800000 * (R1 STILL POINTS TO THE ADT) 00801000 L R15,ATRKLKPX GET THE ADDR OF TRKLKPX. V0510 00802000 BALR R14,R15 GIVE BACK THE OLD N'TH CL. V0510 00803000 ICM R0,B'0011',AFTOCLDX GET "OLD" AFTCLDX @VA01100 00804000 BZ NOCLDX (IF ANY) @VA01100 00805000 * (R1 STILL POINTS TO THE ADT) 00806000 L R15,ATRKLKPX GET ADDR OF TRKLKPX AGAIN @VA01100 00807000 BALR R14,R15 AND "DO IT AGAIN, SAM". @VA01100 00808000 NOCLDX ICM R0,B'0011',AFTFCLX GET OLD FCL DISK ADDR IF ANY @VA01100 00809000 BZ NOFCLX IF NOT, DON'T TRY TO GIVE BACK @VA01100 00810000 * (R1 STILL POINTS TO THE ADT) 00811000 L R15,AQQTRKX GET THE ADDR OF QQTRKX. V0510 00812000 BALR R14,R15 GIVE BACK THE OLD FCL. V0510 00813000 NOFCLX SR R15,R15 FINALLY, CLEAR ... @VA01100 00814000 ST R15,AFTFCLX AFTFCLX AND AFTCLDX @VA01100 00815000 STH R15,AFTOCLDX AND "OLD AFTCLDX" @VA01100 00816000 NI AFTFLG2,255-(AFTCLX+AFTOLDCL) CLEAR FLAG BITS @VA01100 00817000 LR R0,R2 POINT TO THE ADT AGAIN. V0510 00818000 LNR R1,R0 MAKE THE REGISTER NEGATIVE. V0510 00819000 L R15,AUPDISK GET THE ADDR OF UPDISK AGAIN. V0510 00820000 BALR R14,R15 REALLY UPDATE THE DISK NOW. V0510 00821000 CLC AFTCLN(2),ONEH IS THIS A FIRST CHAIN LINK? V0510 00822000 BE ALLDONE NO TROUBLE IF SO. V0510 00823000 OI AFTFLG2,AFTOLDCL SET "AFTOLDCL" FLAGBIT AGAIN @VA01100 00824000 ALLDONE LTR R15,R3 RESTORE RETURN-CODE AND SET C.C. @VA01100 00825000 B WRBEX2 GO TO THE COMMON EXIT. V0510 00826000 EJECT 00827000 ********************************************************************** 00828000 * 00829000 * VARIABLE LENGTH ITEM ROUTINE 00830000 * FILE JUST OPENED. 00831000 * 00832000 ********************************************************************** 00833000 * 00834000 VARINT SR R4,R4 ZERO OUT A REGISTER. V0510 00835000 ICM R4,B'0011',AFTIC GET THE NUMBER OF ITEMS. V0510 00836000 CLM R4,B'0011',AFTWP REPLACING LAST RECORD ? @VA09491 00836040 BE LASTREC YES, OK @VA09491 00836080 BL MAYADD CHECK FOR ADDING NEXT RECORD @VA09491 00836120 TM AFTFLG2,AFTNEW CHECK NEW FILE @VA09491 00836160 BO LASTREC YES, ALLOW DIFFERENT LENGTH @VA09491 00836200 TM DOSFLAGS,DOSMODE IN DOS MOD ? @VA09491 00836240 BO LASTREC YES, SKIP LENGTH CHECK @VA09491 00836280 OI AFTFLG2,SAMELEN CHECK SAME LENGTH @VA09491 00836320 LH R6,FCBNUM COUNT OF FCB ENTRIES @VA09491 00836360 LTR R6,R6 ARE THERE ANY ? @VA09491 00836400 BZ LASTREC NO , SKIP THE CHECK @VA09491 00836440 LA R3,0(,R11) POINT TO WRBUF PLIST @VA09491 00836480 S R3,SIXTEEN BACK UP 4 WORDS @VA09491 00836520 L R7,FCBFIRST FCB ANCHOR @VA09491 00836560 USING FCBSECT,R7 FCB ADDRESSABILITY @VA09491 00836600 LOOPFCB EQU * @VA09491 00836640 CLC FCBDD,EIGHT(R3) FCB DDNAME IN PLIST @VA09491 00836680 BE FOUNDFCB YES, CHECK IT @VA09491 00836720 L R7,0(,R7) BUMP TO NEXT FCB @VA09491 00836760 BCT R6,LOOPFCB LOOP THRU ENTRIES @VA09491 00836800 B LASTREC NOT FOUND @VA09491 00836840 FOUNDFCB EQU * CHECK RECORD FORMAT @VA09491 00836880 NI AFTFLG2,255-SAMELEN NO LENGTH CHECK @VA09491 00836920 LA R7,0(,R7) CLEAR HIGH BYTE @VA09491 00836960 CR R7,R3 THE SAME FCB ? @VA09491 00837000 BNE LASTREC NO, FORGET IT @VA09491 00837040 ICM R3,M7,DEBDCBAD+1 DCB POINTER IN FCB @VA09491 00837080 BZ LASTREC NO , SKIP DCB CHECK @VA09491 00837120 C R3,VMSIZE BEYOND ADDRESSABILITY @VA09491 00837160 BNL LASTREC YES , SKIP IT @VA09491 00837200 USING IHADCB,R3 DCB ADDRESSABILITY @VA09491 00837240 TM DCBRECFM,UND RECFM = UNDEFINED @VA09491 00837280 BO LASTREC YES , SKIP LENGTH CHECK @VA09491 00837320 OI AFTFLG2,SAMELEN ALL REPLACES MUST BE @VA09491 00837360 * THE SAME LENGTH AS BEFORE @VA09491 00837400 B LASTREC BYPASS NEXT CHECK @VA09491 00837440 DROP R3 DROP DCB ADDRESSABILITY @VA09491 00837480 DROP R7 DROP FCB ADDRESSABILITY @VA09491 00837520 MAYADD DS 0H @VA09491 00837560 LA R4,1(,R4) CHECK FOR ADDING ONE RECORD @VA09491 00837600 SR R15,R15 EMPTY ANOTHER REGISTER. V0510 00838000 ICM R15,B'0011',AFTWP AND GET THE WRITE-POINTER. V0510 00839000 CR R4,R15 WRITE PTR. MUST NOT EXCEED NO. OF ITEMS 00840000 BL ERROR7 ERROR 7 IF TROUBLE 00841000 LASTREC DS 0H @VA09491 00841500 SR 3,3 SET TO READ BLOCK NO. 0 00842000 MVC AFTIN(2),ONEH SET THE ITEM NO. TO 1. V0510 00843000 STH R3,AFTID SET DISPLACEMENT = 0 00844000 BAL R14,DISKRD READ APPROPRIATE DATA BLOCK @VM03232 00845000 VARLP1 CLC AFTIN(2),AFTWP ARE WE AT WRITE PLACE 00846000 BE ALLSET YUP, ALMOST FINISHED 00847000 LH 2,AFTID GET DISPLACEMENT WITHIN DATA BLOCK 00848000 C 2,F798 IS ITEM LENGTH IN BLOCK 00849000 BH OVERLP NO, IT PROTRUDES 00850000 BE OVERL3 ONLY LENGTH IN BLOCK 00851000 LR 5,2 GET LOC. OF ITEM LENGTH 00852000 A 5,AFTDBA ... 00853000 SR R15,R15 CLEAR REG, @VM03232 00854000 ICM R15,B'0011',0(R5) MOVE TO NEXT ITEM @VM03232 00855000 LA 2,2(2,15) (ADJUST FOR 2-BYTE ITEM LENGTH) 00856000 VARLP2 EQU * ... 00857000 C R2,EIGHTHD IS ITEM IN THIS BLOCK? V0510 00858000 BL INBLCK YES, SET ITEM NO. AND DISPLACEMENT 00859000 S R2,EIGHTHD SAVE THE COUNT. V0510 00860000 ST 2,SAVECT ... 00861000 LA 3,1(,3) GET NEXT BLOCK 00862000 BAL R14,DISKRD ... @VM03232 00863000 L 2,SAVECT RESTORE COUNT 00864000 B VARLP2 TEST FOR ITEM 00865000 INBLCK STH 2,AFTID STORE DISPLACEMENT 00866000 SR R2,R2 EMPTY A REGISTER V0510 00867000 ICM R2,B'0011',AFTIN GET ITEM-NUMBER FOR INCREMENTINV0510 00868000 LA 2,1(,2) ... 00869000 STH 2,AFTIN ... 00870000 B VARLP1 TEST ITEM NUMBER 00871000 SPACE 1 00872000 OVERLP C R2,EIGHTHD IS IT IN THE NEXT BLOCK? V0510 00873000 BE OVERL2 YES, READ IT IN 00874000 LR 5,2 GET LOC. OF FIRST BYTE 00875000 A 5,AFTDBA ... 00876000 MVC ALIGN(1),0(5) MOVE FIRST BYTE 00877000 LA 3,1(,3) READ NEXT BLOCK 00878000 BAL R14,DISKRD ... @VM03232 00879000 L 5,AFTDBA GET LOC. OF SECOND BYTE 00880000 MVC ALIGN+1(1),0(5) ... 00881000 L R2,FALIGN GET ITEM LENGTH 00882000 LA 2,1(,2) (ADJUST FOR 1-BYTE LENGTH) 00883000 B VARLP2 CONTINUE ON 00884000 OVERL2 LA 3,1(,3) READ NEXT BLOCK 00885000 BAL R14,DISKRD ... @VM03232 00886000 L 5,AFTDBA GET ITEM LENGTH 00887000 SR R2,R2 MAKE A WORK REGISTER. V0510 00888000 ICM R2,B'0011',0(R5) V0510 00889000 LA 2,2(,2) (ADJUST FOR 2-BYTE LENGTH) 00890000 B VARLP2 CONTINUE ON 00891000 OVERL3 LR 5,2 GET LOC. OF ITEM LENGTH 00892000 A 5,AFTDBA ... 00893000 MVC ALIGN(2),0(5) SAVE ITEM LENGTH 00894000 LA 3,1(0,3) GET NEXT BLOCK 00895000 BAL R14,DISKRD ... @VM03232 00896000 L R2,FALIGN SET ITEM LENGTH 00897000 B VARLP2 CONTINUE 00898000 SPACE 3 00899000 ********************************************************************** 00900000 * 00901000 * VARIABLE LENGTH ITEM ROUTINE 00902000 * FILE WAS ALREADY OPEN. 00903000 * 00904000 ********************************************************************** 00905000 VARINS LH R3,AFTDBN BE SURE TO SET BLOCK NO. CORRECTLY P3060 00906000 CLC AFTIN(2),AFTWP ARE WE AT THE WRITE PLACE? P3060 00907000 BE ALLSET YES, THAT WAS EASY 00908000 L R6,AFTDBA POINT TO THE DATA BLOCK BUFFER. V0510 00909000 LA R8,AFTDBD POINT TO THE DISK ADDR OF THE DATA V0510 00910000 BAL R14,CONFSWR WRITE OUT THE DATA BLK (IF ANY) @VM03232 00911000 BZ VARINT IF R15 = 0, SEARCH FOR CORRECT PLACE 00912000 ERROR3 L R14,ADISKDIE STOP NOW TO PRESERVE @VA00895 00913000 BR R14 OLD DIRECTORY @VA00895 00914000 EJECT 00915000 ********************************************************************** 00916000 * 00917000 * VARIABLE LENGTH ITEM ROUTINE 00918000 * SET VARIABLE LENGTH ITEM LENGTH, AND INSERT DATA 00919000 * 00920000 ********************************************************************** 00921000 ALLSET LH 2,AFTID GET DISPLACEMENT 00922000 C 2,F798 IS EVERYTHING IN THIS BLOCK 00923000 BH ALS2 NO, ADJUST THINGS 00924000 BE ALS5 ONLY LENGTH IN THIS BLOCK 00925000 ALS4 LTR R5,R2 GET DISPLACEMENT FOR ITEM LENGTH @VM03232 00926000 BNZ ALS4A BEWARE OF 0 (OK IF NOT). @VM03232 00927000 CH R5,AFTDBD IS DATA BLOCK NONEXISTENT ? @VM03232 00928000 BNE ALS4A NOPE (WHEW) - WE'RE OK. @VM03232 00929000 BAL R14,DISKRD YES - INITIALIZE DATA BLOCK @VM03232 00930000 ALS4A A R5,AFTDBA FORM ADDRESS FOR ITEM LENGTH @VM03232 00931000 TM AFTFLG2,SAMELEN MUST CHECK LENGTH ? @VA09491 00931100 BZ LAB1 NO,CONTINUE @VA09491 00931200 CLC 0(2,R5),PNOBY+2(R11) IS LENGTH OK @VA09491 00931300 BNE ERROR27 NO , WRONG LENGTH @VA09491 00931400 LAB1 DS 0H @VA09491 00931500 MVC 0(2,5),PNOBY+2(11) INSERT ITEM LENGTH 00932000 LA 2,2(,2) ADJUST DISPLACEMENT 00933000 L 5,PNOBY(,11) SET NUMBER OF BYTES TO WRITE 00934000 B INSRT INSERT DATA INTO BLOCK 00935000 ALS2 C R2,EIGHTHD IS IT IN THIS BLOCK? V0510 00936000 BE ALS3 NO, GET NEXT ONE 00937000 LR 5,2 GET LOC. TO PUT FIRST BYTE 00938000 A 5,AFTDBA ... 00939000 TM AFTFLG2,SAMELEN MUST CHECK LENGTH ? @VA09491 00939100 BZ LAB2 NO, CONTINUE @VA09491 00939200 CLC 0(1,R5),PNOBY+2(R11) IS FIRST HALF OK ? @VA09491 00939300 BNE ERROR27 NOPE @VA09491 00939400 LAB2 DS 0H @VA09491 00939500 MVC 0(1,5),PNOBY+2(11) INSERT FIRST BYTE TO ITEM LENGTH 00940000 LA 3,1(,3) GET NEXT BLOCK 00941000 BAL R14,DISKRW ... @VM03232 00942000 L 5,AFTDBA GET LOC. TO PUT SECOND BYTE 00943000 TM AFTFLG2,SAMELEN MUST CHECK LENGTH @VA09491 00943100 BZ LAB3 NO, CONTINUE @VA09491 00943200 CLC 0(1,R5),PNOBY+3(R11) IS SECOND HALF OK ? @VA09491 00943300 BNE ERROR27 NO, DIFFERENT LENGTH @VA09491 00943400 LAB3 DS 0H @VA09491 00943500 MVC 0(1,5),PNOBY+3(11) INSERT SECOND BYTE 00944000 LA 2,1 SET DISPLACEMENT=1 00945000 L 5,PNOBY(,11) SET NUMBER OF BYTES TO WRITE 00946000 B INSRT INSERT DATA INTO BLOCK 00947000 ALS3 LA 3,1(,3) GET NEXT BLOXK 00948000 BAL R14,DISKRW ... @VM03232 00949000 SR 2,2 SET DISPLACEMENT=0 00950000 B ALS4 SET ITEM LENGTH 00951000 ALS5 LR 5,2 GET LOC. TO PUT ITEM LENGTH 00952000 A 5,AFTDBA ... 00953000 TM AFTFLG2,SAMELEN MUST CHECK LENGTH @VA09491 00953100 BZ LAB4 NO, CONTINUE @VA09491 00953200 CLC 0(2,R5),PNOBY+2(R11) IS LENGTH OK @VA09491 00953300 BNE ERROR27 NO, DIFFERENT LENGTH @VA09491 00953400 LAB4 DS 0H @VA09491 00953500 MVC 0(2,5),PNOBY+2(11) INSERT ITEM LENGTH 00954000 LA 3,1(0,3) GET NEXT BLOCK 00955000 BAL R14,DISKRW ... @VM03232 00956000 SR 2,2 SET DISPLACEMENT 00957000 L 5,PNOBY(0,11) AND NO. OF BYTES 00958000 B INSRT INSERT DATA 00959000 ERROR27 EQU * @VA09491 00959200 LA R15,27 ERROR CODE 26 @VA09491 00959400 B ERR RETURN WITH AN ERROR @VA09491 00959600 EJECT 00960000 ********************************************************************** 00961000 * 00962000 * DISK INTERFACE ROUTINE FOR FIXED OR VARIABLE LENGTH ITEM(S) 00963000 * 00964000 * PARAMETERS- 00965000 * 00966000 * REG. 3 - DESIRED DATA BLOCK NO. 00967000 * REG. 14 - RETURN ADDRESS 00968000 * 00969000 ********************************************************************** 00970000 * 00971000 * DISKRD - READ DESIRED BLOCK 00972000 DISKRD ST R14,DSKRET SAVE RETURN ADDRESS @VM03232 00973000 B SWICH2 GO TO IT @VM03232 00974000 * 00975000 * DISKRW - WRITE CURRENT BLOCK BEFORE READ 00976000 DISKRW ST R14,DSKRET SAVE RETURN ADDRESS @VM03232 00977000 * 00978000 * CONTINUE 'IN LINE' TO 'SWICH' ... 00979000 SPACE 00980000 ******************************************************** 00981000 * 00982000 * THE CURRENT DATA BLOCK IS WRITTEN ON THE DISK. IF A 00983000 * DIFFERENT CHAIN LINK IS REQUIRED TO DEFINE THE NEW DATA 00984000 * BLOCK, THE OLD CHAIN LINK IS WRITTEN ONTO THE DISK AND 00985000 * THE NEXT CHAIN LINK IS OBTAINED FROM THE DISK IF IT HAD 00986000 * BEEN PREVIOUSLY DEFINED. IF A NEW CHAIN 00987000 * LINK MUST BE DEFINED, ITS ADDRESS IS PLACED IN THE FIRST 00988000 * CHAIN LINK. THE NEXT DATA BLOCK THEN IS READ FROM 00989000 * THE DISK IF IT PREVIOUSLY EXISTED, OR IF IT DID NOT EXIST, 00990000 * IT IS NOW DEFINED BY PLACING ITS NEW DISK ADDRESS IN THE 00991000 * CHAIN LINK. THE PROGRAM RETURNS TO THE PRIVIOUS SECTION 00992000 * OF CODE FOR INSERTION OF THE DATA ITEM INTO THE DATA BLOCK 00993000 * WHICH WAS JUST SET UP IN CORE. 00994000 * 00995000 ********************************************** 00996000 SWICH L R6,AFTDBA POINT TO THE DATA BLOCK BUFFER. V0510 00997000 LA R8,AFTDBD INDICATE THE DISK ADDR. V0510 00998000 BAL R14,CONFSWR WRITE OUT THE DATA BLK (IF ANY) @VM03232 00999000 BNZ ERROR3 BNZ IF PERMANENT I/O ERROR ON DISK. 01000000 SWICH2 LH 8,AFTCLN IS THIS THE RIGHT 01001000 C 8,ONE CHAIN LINK 01002000 BE RCL YES - BRANCH. @VM03232 01003000 SH R8,TWOH NO - CALCULATE @VM03232 01004000 L 7,FOURHD (X-2)*400+60 01005000 MR 6,8 01006000 AH 7,SIXTY LOWER LIMIT TEST 01007000 CR 7,3 01008000 BH LINKSW WRONG CHAIN LINK 01009000 A 7,THRNN 01010000 CR 7,3 UPPER LIMIT TEST 01011000 BNL NLKPTR RIGHT BLOCK NO. 01012000 LINKSW L R6,AFTCLA POINT TO THE CHAIN LINK BUFFER V0510 01013000 LA R8,AFTCLD POINT TO THE ADDR ON DISK V0510 01014000 BAL R14,FSWR WRITE OUT THE CHAIN LINK. V0510 01015000 BNZ ERROR3 QUIT IF UNEXPECTED ERROR. V0510 01016000 TM AFTFLG2,AFTCLX HAS ANY MODIFICATION TAKEN PLACE? V0510 01017000 BNO RELINK PROCEED WITH ABANDON,IF NOT. V0510 01018000 O R13,SIGNBIT R13 'MINUS' MEANS C.L. HAS BEEN WRITTEN 01019000 RELINK CH 3,FIFNI IS BLOCK NO. BETWEEN 01020000 BH MORTST ZERO AND 59 01021000 MVC AFTCLN(2),ONEH SET CHAIN-LINK-NUMBER TO 1 01022000 MVC AFTCLD(2),AFTFCL DISK ADDR OF FCL. V0510 01023000 CLNUP NI AFTFLG2,255-AFTOLDCL ALL ELSE CORRECT. V0510 01024000 LR R4,R3 MAKE A COPY OF THE BLOCK NUMBER. V0510 01025000 AR R4,R4 DOUBLE IT, FOR INDEXING. V0510 01026000 LA R4,80(,R4) SHOW OFFSET INTO FCL FOR DATA BLOCK V0510 01027000 L R8,AFTFCLA POINT TO FCL BUFFER. V0510 01028000 B FCLNUP PRETEND THAT WE JUST READ IT IN. V0510 01029000 * 01030000 RCL CH R3,FIFNI IS BLOCK NO. BETWEEN 0 AND 59 ? @VM03232 01031000 BNH CLNUP BRANCH IF YES @VM03232 01032000 TM AFTFLG2,AFTCLX HAS ANY MODIFICATION TAKEN PLACE?@VM03232 01033000 BNO MORTST NO WORRY, IF NOT. @VM03232 01034000 O R13,SIGNBIT PRETEND A CHAIN LINK WAS WRITTEN @VM03232 01035000 * AND CONTINUE TO "MORTST" ... 01036000 MORTST SR 6,6 CALCULATE (N-60)/400+2 01037000 LR 7,3 =X=NO. C.L. TO BE 01038000 SH 7,SIXTY PLACED IN CORE 01039000 D 6,FOURHD 01040000 LA 7,2(0,7) 01041000 CH R7,MAXCHAIN ARE BEYOND CHAIN-LINK 41 ? 01042000 BH ERROR19 ERROR 19 IF YES - DON'T LET HIM DO IT. 01043000 STH 7,AFTCLN 01044000 TM AFTFLG,AFTFBA IS BUFFER FOR N'TH 01045000 BO CLODT CHAIN LINK ASSIGNED, YES 01046000 LA R0,100 GET N'TH CHAIN-LINK BUFFER. V0510 01047000 DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR V0510 01048000 LTR R15,R15 MUST ACQUIRE FREE STORAGE @VA02374 01049000 BNZ ERROR25 OR FAIL @VA02374 01050000 ST 1,AFTCLA 01051000 OI AFTFLG,AFTFBA SET N'TH BUF. ASSIGN. BIT 01052000 CLODT LH 8,AFTCLN DOES CHAIN LINK 01053000 AR R8,R8 SOUGHT EXIST ON 01054000 SH 8,FOUR DISK-CALCULATE X*2-4 01055000 LH R6,AFTCLB(R8) 01056000 LTR 6,6 01057000 BZ ASQRK NO 01058000 STH 6,AFTCLD STORE DISK ADDR. OF CHAIN LINK 01059000 L R6,AFTCLA POINT TO THE CHAIN LINK BUFFER. V0510 01060000 LA R8,AFTCLB(R8) POINT TO OFFSET OF CHAIN LINK ADDR V0510 01061000 BAL R14,FSRD READ IN THE CHAIN LINK. V0510 01062000 BNZ ERROR3 QUIT ON ERROR CONDITION. V0510 01063000 OI AFTFLG2,AFTOLDCL SIGNAL NCL EXISTED PREVIOUSLY. V0510 01064000 B NLKPTR NOW LOCATE THE DATA BLOCK. V0510 01065000 ASQRK BAL R14,GETBLOCK GET A CHAIN LINK ALLOCATED. V0510 01066000 BNZ BADNEWS IF ERROR FROM TRKLKP GETTING A CHAIN-LINK 01067000 STH 1,AFTCLD DISK ADDR. OF CHAIN LINK IN CORE 01068000 STH R1,AFTCLB(R8) INSERT C.L. ADDR. IN F.C.L. 01069000 L 14,AFTCLA CLEAR N'TH CHAIN 01070000 L R15,EIGHTHD SIZE INTO R15 @VA01100 01071000 SR R1,R1 CLEAR R1 (R0 IS IMMATERIAL) @VA01100 01072000 MVCL R14,R0 CLEAR THE N'TH CHAIN LINK @VA01100 01073000 NLKPTR LR 7,3 FIND POINTER TO ADDRESS 01074000 SH 7,SIXTY OF DATA BLOCK IN 01075000 SR R6,R6 CHAIN LINK 01076000 D 6,FOURHD EQUAL REMAINDER OF (X-60)/400=R 01077000 AR 6,6 R*2=POINTER 01078000 LR 4,6 01079000 L R8,AFTCLA POINT TO THE CHAIN LINK BUFFER. V0510 01080000 FCLNUP SR R6,R6 CREATE POINTER COMPARATOR. V0510 01081000 AR R4,R8 RESOLVE OFFSET OF DATA ADDR. V0510 01082000 CH R6,0(,R4) IS ANYTHING THERE? V0510 01083000 BE QTRK GET ONE, IF NOT. V0510 01084000 L R6,AFTDBA POINT TO THE DATA BUFFER. V0510 01085000 LR R8,R4 POINT TO THE DISK ADDR. V0510 01086000 BAL R14,FSRD READ IN THE BLOCK. V0510 01087000 BNZ ERROR3 BNZ IF PERMANENT I/O ERROR ON DISK. 01088000 MVC AFTDBD(2),0(4) INSERT DISK ADDR. OF DATA 01089000 STH 3,AFTDBN PUT CURRENT BLOCK NO. IN TABLE 01090000 B DISKRRT RETURN TO INSERT NEW ITEM 01091000 * BLOCK CURRENTLY IN CORE 01092000 QTRK CLC AFTDBC(2),MAXBLKS MAX. NO. OF DATA BLOCKS BEEN REACHED 01093000 BNL ERROR19 ERROR 19 IF YES - QUIT NOW. 01094000 BAL R14,GETBLOCK ASSIGN A BLOCK. V0510 01095000 BNZ NEWCHECK BNZ IF ERROR-CODE FROM TRKLKP NOT = 0. 01096000 LH R14,AFTDBC INCREMENT NO. OF QUARTER DATA TRACKS 01097000 LA 14,1(,14) 01098000 STH R14,AFTDBC REPLACE IN F.S.T. TABLE 01099000 STH 1,AFTDBD D.A. OF DATA BLOCK IN CORE 01100000 STH 1,0(0,4) DISK ADDR. TO CHAIN LINK 01101000 STH R3,AFTDBN PUT CURRENT BLOCK NO. IN TABLE 01102000 L 14,AFTDBA CLEAR DATA BLOCK 01103000 L R15,EIGHTHD SIZE INTO R15 @VA01100 01104000 SR R1,R1 CLEAR R1 (R0 IS IMMATERIAL) @VA01100 01105000 MVCL R14,R0 CLEAR THE DATA BLOCK @VA01100 01106000 TM AFTFLG2,AFTNEW IS THIS A NEW FILE? V0510 01107000 BO NOSWAP NO WORRIES, IF SO. V0510 01108000 TM AFTFLG2,AFTOLDCL MODIFYING SOMETHING PERCHANCE? V0510 01109000 BNO FLAGMOD IF NOT, SIGNAL IT MILDLY ANYWAY. V0510 01110000 BAL R14,GETBLOCK GET AN ALTERNATE NTH CHAIN LINK @VA01100 01111000 BNZ PORCPINE IF N.G., HANDLE "VERY CAREFULLY" @VA01100 01112000 LH R8,AFTCLN GET THE CHAIN LINK NUMBER. V0510 01113000 AR R8,R8 DOUBLED, FOR HALF-WORD LOGIC. V0510 01114000 SH R8,FOUR AND OFFSET A LITTLE. V0510 01115000 MVC AFTOCLDX(2),AFTCLDX SAVE "OLD AFTCLDX" (IF ANY) @VA01100 01116000 LH R15,AFTCLB(R8) NOW , GET THE OLD DISK ADDR. V0510 01117000 STH R15,AFTCLDX SAVE IT FOR LATER. V0510 01118000 STH R1,AFTCLB(R8) INSTALL THE ALTERNATE ADDR. V0510 01119000 STH R1,AFTCLD ALL OVER THE PLACE. V0510 01120000 FLAGMOD OI AFTFLG2,AFTCLX SAY SOMETHING HAS BEEN CHANGED. V0510 01121000 * ASSIGN AN ALTERNATE FIRST CHAIN LINK (UNLESS WE ALREADY HAVE ONE): 01122000 L R15,AFTADT @VM03203 01123000 USING ADTSECT,R15 @VM03203 01124000 TM ADTFLG3,ADTFXCHN ANY OLD CHAIN LINKS? @VM03203 01125000 BNO FLGMODA NO, THEN CONTINUE @VM03203 01126000 O R13,SIGNBIT YES,THEN CALL TFINIS LATER @VM03203 01127000 DROP R15 @VM03203 01128000 FLGMODA SR R0,R0 GET 'OLD' FIRST CHAIN LINK @VM03203 01129000 ICM R0,B'0011',AFTFCLX DOES IT EXIST ? @VA01100 01130000 BNZ NOSWAP IF YES, WE ALREADY HAVE NEW ONE @VA01100 01131000 L R1,AFTADT NO, POINT TO THE ADT; @VA01100 01132000 L R15,AQQTRK AND GET A "NEW" FIRST CHAIN LINK @VA01100 01133000 BALR R14,R15 ..... @VA01100 01134000 BNZ NOSWAP UH-OH IF NO ROOM LEFT AT THE INN @VA01100 01135000 MVC AFTFCLX(2),AFTFCL SAVE OLD FCL DISK-ADDRESS @VA01100 01136000 STH R1,AFTFCL START USING THE NEW FCL @VA01100 01137000 CLC AFTCLN(2),ONEH IS THIS THE FCL ? @VA01100 01138000 BNE NOSWAP NO - NOT AT THE MOMENT @VA01100 01139000 STH R1,AFTCLD YES - STORE HERE ALSO @VA01100 01140000 NOSWAP NI AFTFLG2,255-AFTOLDCL CLEAR "AFTOLDCL" FLAG @VA01100 01141000 DISKRRT L R14,DSKRET GET RETURN-ADDRESS @VM03232 01142000 BR R14 HOME AGAIN. @VM03232 01143000 SPACE 01144000 * HANDLE "VERY CAREFULLY" IF ALTERNATE NTH CHAIN LINK IS UNAVAILABLE... 01145000 PORCPINE LR R0,R1 SET UP R0, @VA01100 01146000 L R1,AFTADT ALSO SET UP R1, AND @VA01100 01147000 L R15,ATRKLKPX GIVE BACK THE BLOCK @VA01100 01148000 BALR R14,R15 (SINCE WE WON'T BE USING IT) @VA01100 01149000 O R13,SIGNBIT FORCE CALL TO TFINIS ETC WHEN WE @VA01100 01150000 B FLAGMOD ARE DONE; GO SET FLAG & CONTINUE @VA01100 01151000 SPACE 3 01152000 FSRD LA R7,800 ASSUME AN 800-BYTE BLOCK. V0510 01153000 FSRD1 L R15,ARDTK GET THE ADDR OF RDTK. V0510 01154000 B RDWR GET COMMON. V0510 01155000 * "CONDITIONAL" ENTRY EQUIVALENT TO "FSWR" WHERE AFTDBD IS USED: 01156000 CONFSWR SR R15,R15 WRITE DATA BLOCK IF IT EXISTS: @VM03232 01157000 CH R15,AFTDBD AS GIVEN BY "AFTDBD" @VM03232 01158000 BER R14 IF NONEXISTENT, RETURN FORTHWITH @VM03232 01159000 FSWR L R15,AWRTK GET THE ADDR OF WRTK. V0510 01160000 LA R7,800 ASSUME 800-BYTE WRITE. V0510 01161000 RDWR LA R1,PLIST POINT TO THE PLIST. V0510 01162000 STM R6,R8,PLIST SET UP PASSED PARAMS. V0510 01163000 BR R15 READ/WRITE WITH RETURN TO CALLER. V0510 01164000 SPACE 1 01165000 GETBLOCK L R1,AFTADT POINT TO THE ADT. V0510 01166000 L R15,ATRKLKP GET THE ADDR OF TRKLKP. V0510 01167000 BR R15 GET A BLOCK AND RETURN. V0510 01168000 EJECT 01169000 ********************************************************************** 01170000 * 01171000 * CONSTANTS AND DEFINITIONS 01172000 * 01173000 ********************************************************************** 01174000 * 01175000 * PARAMETER LIST DISPLACEMENTS (GENERALLY R11) 01176000 * 01177000 PFILE EQU 8 01178000 PTYPE EQU 16 01179000 PMODE EQU 24 01180000 PITEM EQU 26 01181000 PADDR EQU 28 01182000 PNOBY EQU 32 01183000 PFIVA EQU 36 01184000 PNOIT EQU 38 01185000 * 01186000 * NUMERICAL CONSTANTS 01187000 * 01188000 * HALFWORD CONSTANTS ... 01189000 * 01190000 TWOH DC H'2' 01191000 FOUR DC H'4' 01192000 FIFNI DC H'59' 01193000 SIXTY DC H'60' 01194000 * 01195000 MAXFILES DC H'3400' MAX. NO. OF FILES CMS CAN HANDLE @VA03764 01196000 MAXBLKS DC H'16060' MAXIMUM NO. OF DATA BLOCKS FOR ONE FILE 01197000 MAXCHAIN DC H'41' HIGHEST CHAIN-LINK WE CAN NOW HANDLE 01198000 SIXTEEN DC F'16' FULLWORD SIXTEEN @VA09491 01198500 * 01199000 * FULLWORD CONSTANTS 01200000 * 01201000 ONE DC F'1' 01202000 ONEH EQU ONE+2 'ONE' AS A HALFWORD. 01203000 FOURHD DC F'400' 01204000 THRNN DC F'399' 01205000 ONEGRP DC F'256' 01206000 F798 DC F'798' 01207000 EIGHTHD DC F'800' V0510 01208000 * 01209000 * ADDRESS CONSTANTS 01210000 * 01211000 SIGNBIT DC X'80000000' TO SIGNAL THAT CHAIN-LINK HAS BEEN WRITTEN 01212000 * 01213000 * EQUATES 01214000 * 01215000 M3 EQU 3 @VA07151 01216000 M7 EQU 7 MASK SEVEN @VA09491 01216200 EIGHT EQU 8 MISCELLANEOUS 8 @VA09491 01216400 EJECT 01217000 * 01218000 * SPECIAL ERROR-HANDLING PURPOSELY AT THE END ... 01219000 * (R10 ADDRESSABILITY STILL IN EFFECT) 01220000 * 01221000 ADISKDIE DC V(DISKDIE) 'DIE' FOR DISK-ERROR. 01222000 * 01223000 QQBAD L R2,AFTADT R2 POINTS TO ADT FOR MESSAGE HANDLING 01224000 B RELQQ ERROR 01225000 * 01226000 * WATCH OUT FOR NEW DATA-BLOCK IN NEW CHAIN-LINK ... 01227000 * 01228000 NEWCHECK LA R2,4 SET INCREMENTER AND @VA01100 01229000 LA R3,796(,R8) SET LIMIT FOR BXLE (R6 STILL=0) @VA01100 01230000 CR604 C R6,0(,R8) IS CHAIN-LINK ALL ZEROES ? @VA01100 01231000 BNE JCHECK TRF IF NOT COMPLETELY EMPTY @VA01100 01232000 BXLE R8,R2,CR604 ITERATE FOR ENTIRE 800-BYTE C. L.@VA01100 01233000 LR R2,R1 SAVE R1 FOR LATER, 01234000 LR R3,R15 DITTO R15 01235000 L R15,ATRKLKPX CALL TRKLKPX 01236000 SR R0,R0 EMPTY A REGISTER V0510 01237000 ICM R0,B'0011',AFTCLD GET THE DASD ADDR OF THE CHAIN-V0510 01238000 L R1,AFTADT EMPTY CHAIN-LINK 01239000 BALR R14,R15 ... 01240000 LH R8,AFTCLN GET CHAIN-LINK-NUMBER 01241000 AR R8,R8 TIMES TWO (E.G. 4,6,8, ETC.) 01242000 STH R6,AFTCLB-4(R8) CLEAR EMPTY C.L. IN ACTTAB LINKAGE 01243000 STH R6,AFTCLD ***** AND HERE IF NECESSARY ************* 01244000 LR R1,R2 RESTORE R1 AND 01245000 LR R15,R3 R15 FROM BEFORE 01246000 * 01247000 BADNEWS OI AFTFLG,AFTFULD WARN FINIS NOT TO WRITE NULL CHAIN-LINK 01248000 * 01249000 JCHECK CH R15,FOUR SEE IF = ERROR 4 ('VERY FEW' LEFT) ? 01250000 BNE WRCHECK BNE IF NOT, MAKE ONE FURTHER CHECK 01251000 BAL R14,GIVEBACK GIVE BACK BLOCK WE WON'T USE @VM03232 01252000 WRCHECK L R2,AFTADT R2 POINTS TO ADT FOR MESSAGE HANDLING 01253000 SR R8,R8 CLEAR A HANDY REGISTER, 01254000 CH R8,AFTDBC DO WE HAVE ANY DATA-BLOCKS AT ALL YET ? 01255000 BL ERROR13 BL IF YES (> 0), FINIS WILL FINISH IT UP. 01256000 L R1,AFTADT IF FILE 'NULL', SET UP R1 01257000 SR R0,R0 ZERO REGISTER 0 V0510 01258000 ICM R0,B'0011',AFTFCL GET THE FIRST CHAIN LINK ADDR @VA01109 01259000 L R15,AQQTRKX CALL QQTRKX TO GIVE BACK THE 1ST CHAIN 01260000 BALR R14,R15 LINK (SINCE WE WON'T BE USING IT) 01261000 USING ADTSECT,R1 01262000 L R15,ADTFSTC TOTAL NUMBER OF FILES. V0510 01263000 BCTR R15,0 DECREMENT 01264000 ST R15,ADTFSTC STORE AS THE NEW VALUE. V0510 01265000 LH R15,ADTNACW NO. OF FILES OPEN FOR WRITING 01266000 BCTR R15,0 DECREMENT BY 1 01267000 STH R15,ADTNACW STORE NEW VALUE 01268000 DROP R1 01269000 LA R0,125 RETURN THE 1000-BYTE AREA 01270000 L R1,AFTFCLA WHICH IS STILL LYING AROUND @VA01109 01271000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 01272000 RELQQ LR R1,R9 POINT TO ACTIVE-FILE-TABLE, 01273000 L R15,AACTFRET GIVE IT BACK VIA ACTFRET, 01274000 BALR R14,R15 ... 01275000 B ERROR13J JOIN CODE BELOW (WITH R13 PLUS) @VA01100 01276000 * 01277000 GIVEBACK L R15,ATRKLKPX IF ERROR (4) FROM TRKLKP, @VM03232 01278000 LR R0,R1 SET UP R0 FOR TRKLKPX, @VM03232 01279000 L R1,AFTADT ALSO SET UP R1, GIVE IT BACK, @VM03232 01280000 BR R15 AND RETURN DIRECTLY TO CALLER. @VM03232 01281000 * 01282000 ERROR13 DS 0H COMES HERE IF NO (OR VERY FEW) TRACKS LEFT 01283000 O R13,SIGNBIT R13 MINUS TO CALL TFINIS LATER @VA01100 01284000 ERROR13J EQU * JOIN HERE IF FILE = NULL. @VA01100 01285000 LR R8,R2 SET R8 FOR ADDRESSABILITY IN WARMSG 01286000 LA R2,LFULLMSG POINT TO ERROR MESSAGE P0751 01287000 LA R3,107 AND SETUP THE ERROR NUMBER P0751 01288000 BAL R6,WARMSG CALL MESSAGE SUBROUTINE P0751 01289000 CLI AFTFV,C'V' VARIABLE LENGTH? @VA04222 01290000 BE VARGO YES, THEN NO CALC @VA04222 01291000 LH R15,AFTDBC GET NO. DATA BLOCKS @VA04222 01292000 SR R14,R14 ZERO OUT OTH REG @VA04222 01293000 M R14,EIGHTHD GET ANSWER NO. OF BYTES @VA04222 01294000 L R6,AFTIL GET LENGTH OF RECORD @VA04222 01295000 SR R14,R14 CLEAN R14 AGAIN @VA04222 01296000 DR R14,R6 DIVIDE BY LENGTH @VA04222 01297000 CLM R15,3,AFTIC IS ITEM COUNT LARGER NOW? @VA04222 01298000 BNH VARGO NO, THEN DON'T STORE NEW ITEM @VA04222 01299000 * COUNT 01300000 STH R15,AFTIC SET NEW ITEM COUNT @VA04222 01301000 VARGO LA R15,13 SET ERROR CODE 13 @VA04222 01302000 B ERR @VA04222 01303000 * 01304000 ERROR7 LA R15,7 01305000 B ERR 01306000 * 01307000 ERROR4 LA R15,4 ERROR 4 01308000 B ERR 01309000 * 01310000 ERROR19 LA R15,19 ERROR 19 (BEYOND FILE SYSTEM LIMITS) 01311000 B ERR 01312000 SPACE 1 01313000 USING ADTSECT,R12 @VA03665 01314000 ERROR25P L R15,ADTFSTC TOTAL NUMBER OF FILES @VA03665 01315000 TM AFTFLG2,AFTNEW TEST FOR NEW FILE @VA08045 01316000 BNO ERROR25R IF NOT THEN SKIP DECRMNT @VA08045 01317000 BCTR R15,0 DECREMENT @VA03665 01318000 ST R15,ADTFSTC STORE AS THE NEW VALUE @VA03665 01319000 DROP R12 @VA03665 01320000 L R1,AFTADT GET ADDRESS OF ADT @VA03665 01321000 SR R0,R0 @VA03665 01322000 ICM R0,B'0011',AFTFCL GET ADDR OF FIRST CHAIN LINK @VA03665 01323000 L R15,AQQTRKX GIVE BACK FIRST CHAIN LINK @VA03665 01324000 BALR R14,R15 @VA03665 01325000 LR R1,R9 ADDR OF ACTIVE FILE TABLE @VA03665 01326000 ERROR25R EQU * @VA08045 01327000 L R15,AACTFRET GIVE IT BACK @VA03665 01328000 BALR R14,R15 @VA03665 01329000 ERROR25 LA R15,25 CORE NOT AVAILABLE FOR @VA03665 01330000 B ERR UFD BUFFERS @VA03665 01331000 * 01332000 FILSBUST DS 0H TOO MANY FILES ON ONE DISK 01333000 LR R8,R1 SET R8 FOR ADDRESSABILITY IN WARMSG 01334000 LA R2,LBUSTMSG POINT TO THE MESSAGE P0751 01335000 LA R3,170 SET UP THE ERROR NUMBER P0751 01336000 BAL R6,WARMSG CALL MESSAGE SUBROUTINE P0751 01337000 LA R15,10 SET ERROR CODE 10 01338000 B ERR 01339000 * 01340000 JCANTWRT DS 0H DISK CANNOT BE WRITTEN ON 01341000 USING ADTSECT,R1 01342000 CLI ADTMX,C' ' IF ACTIVE FROM POINT, IS IT A ... 01343000 BE CANTWRIT READ-ONLY EXTENSION (ERROR IF NOT). 01344000 CLC 24(1,R11),ADTMX IF YES, DOES IT MATCH CALLER'S MODE ? 01345000 BNE CANTWRIT TRF IF NOT (DEFINITELY IN ERROR). 01346000 DROP R1 01347000 L R15,AACTFRET IF R/O EXT. OF OUR DISK, 01348000 LR R1,R9 RESTORE R1 TO POINT TO AFT ENTRY, 01349000 BALR R14,R15 GET IT OUT OF THE ACTIVE FILE TABLE, 01350000 LR R1,R11 RESTORE R1 TO CALLER'S P-LIST, 01351000 B SR99 AND RE-ENTER LOGIC FOR 'OUR' DISK 01352000 * 01353000 CANTWRIT EQU * 01354000 LA R15,12 SET ERROR CODE 12 01355000 B ERR 01356000 * 01357000 ERROR22 DMSERR TEXT='Virtual Storage capacity exceeded', @VA02525X01358490 NUM=109,LET=S,TYPCALL=BALR @VA02525 01359000 LA R15,22 ERROR CODE 22 @VA02525 01360000 B ERR @VA02525 01361000 * 01362000 USING ADTSECT,R8 P0751 01363000 WARMSG L R7,ADTDTA POINT TO THE DEVICE TABLE ENTRY P0751 01364000 DMSERR MF=(E,'SYS'),NUM=(3),LET=S,TEXTA=(2), P0751*01365000 TYPCALL=BALR,SUB=(CHARA,(ADTM,1),HEX4A,((7),2)) P0751 01366000 BR R6 P0751 01367000 DROP R8 P0751 01368000 * 01369000 LBUSTMSG DC AL1(L'BUSTMSG) P0751 01370000 BUSTMSG DC C'Disk ''..(....)'' has maximum number of files' *01371290 HRC012DS 01371580 * 01372000 LFULLMSG DC AL1(L'FULLMSG) P0751 01373000 FULLMSG DC C'Disk ''..(....)'' is full' HRC012DS 01374490 SPACE 2 01375000 DS 0D ALIGN INVTBL ... @VM03232 01376000 INVTBL DC 256X'40' X'40' MEANS "INVALID" HRC012DS 01377190 ORG INVTBL+78 HRC012DS 01377380 DC X'00' '+' IS VALID PLUS HRC012DS 01377570 ORG INVTBL+91 HRC012DS 01377760 DC X'00' '$' IS VALID DOLLAR HRC012DS 01377950 ORG INVTBL+96 HRC012DS 01378140 DC X'00' '-' IS VALID DASH/HYPHEN HRC012DS 01378330 ORG INVTBL+109 HRC012DS 01378520 DC X'00' '_' IS VALID UNDERSCORE HRC012DS 01378710 ORG INVTBL+122 HRC012DS 01378900 DC X'00' ':' IS VALID COLON HRC012DS 01379090 ORG INVTBL+123 01380000 DC 2X'00' '#' AND '@' ARE VALID @VA01100 01381000 ORG INVTBL+129 01382000 DC 9X'00' LOWER CASE 'A' THRU 'I' ARE VALID @VA01100 01383000 ORG INVTBL+145 01384000 DC 9X'00' LOWER CASE 'J' THRU 'R' ARE VALID @VA01100 01385000 ORG INVTBL+162 01386000 DC 8X'00' LOWER CASE 'S' THRU 'Z' ARE VALID @VA01100 01387000 ORG INVTBL+193 01388000 DC 9X'00' UPPER CASE 'A' THRU 'I' ARE VALID @VA01100 01389000 ORG INVTBL+209 01390000 DC 9X'00' UPPER CASE 'J' THRU 'R' ARE VALID @VA01100 01391000 ORG INVTBL+226 01392000 DC 8X'00' UPPER CASE 'S' THRU 'Z' ARE VALID @VA01100 01393000 ORG INVTBL+240 01394000 DC 10X'00' NUMBERS '0' THRU '9' ARE VALID @VA01100 01395000 ORG , HRC012DS 01396490 SPACE 01397000 LTORG NEEDED CONSTANTS ... @VM03232 01398000 SPACE 01399000 * EQUATES: 01400000 Q80 EQU 80 LENGTH OF NTH CHAIN LINK AREA @VM03232 01401000 * IN FIRST CHAIN LINK. 01402000 Q118 EQU 118 DISPLACEMENT OF LAST DATA BLOCK @VM03232 01403000 * IN FIRST CHAIN LINK AREA. 01404000 Q798 EQU 798 DISPLACEMENT OF LAST DATA BLOCK @VM03232 01405000 * IN NTH (NOT 1ST) CHAIN LINK AREA. 01406000 Q800 EQU 800 LENGTH OF CMS PHYSICAL BLOCKS @VM03232 01407000 FF EQU X'FF' @VM03232 01408000 SPACE 01409000 DS 0D - "WRBUF" ENDS HERE - 01410000 EJECT 01411000 FVS 01412000 * 01413000 PLIST EQU RWFSTRG FOUR WORDS 01414000 PADDRX EQU RWFSTRG+16 ONE WORD 01415000 DSKRET EQU RWFSTRG+20 ONE WORD 01416000 SAVECT EQU RWFSTRG+24 ONE WORD 01417000 FALIGN EQU RWFSTRG+28 (CLEARED BY INITIALIZATION) 01418000 ALIGN EQU FALIGN+2 RIGHT-HALF OF 'FALIGN' 01419000 WRBFLAG1 EQU ALIGN+2 FIRST FLAG-BYTE 01420000 WRBFLAG2 EQU WRBFLAG1+1 SECOND FLAG-BYTE 01421000 * 01422000 END$TEMP EQU WRBFLAG2+1 END OF TEMPORARY STORAGE. 01423000 * 01424000 REGSAV4 EQU RWFSTRG+12 SAFE SAVE-AREA NOT USED BY TFINIS OR UPDISK 01425000 EJECT 01426000 NUCON 01427000 DCBD DSORG=(PS) 01427200 CMSCB 01427400 AFT 01428000 FSTB 01429000 ADT 01430000 REGEQU 01431000 END 01432000