Table of Contents

DMSBWR Source

References

Source Listing

DMSBWR.ASSEMBLE.txt
  1. BWR TITLE 'DMSBWR (CMS) VM/370 - RELEASE 6' 00001000
  2. SPACE 2 00002000
  3. *. 00003000
  4. * MODULE NAME: 00004000
  5. * 00005000
  6. * DMSBWR (WRBUF) 00006000
  7. * 00007000
  8. * FUNCTION: 00008000
  9. * 00009000
  10. * TO WRITE ONE OR MORE SUCCESSIVE ITEMS INTO A 00010000
  11. * SPECIFIED DISK FILE. 00011000
  12. * 00012000
  13. * ATTRIBUTES: 00013000
  14. * 00014000
  15. * NUCLEUS RESIDENT, REENTRANT, CALLED BY BALR OR SVC 00015000
  16. * 00016000
  17. * ENTRY POINTS: 00017000
  18. * 00018000
  19. * DMSBWR (WRBUF) 00019000
  20. * 00020000
  21. * ENTRY CONDITIONS: 00021000
  22. * 00022000
  23. * R1 MUST POINT TO WRBUF PARAMETER LIST: 00023000
  24. * PLIST DC CL8'WRBUF' (NOTE-IMMATERIAL IF CALLED BY BALR) 00024000
  25. * DC CL8' ' FILENAME 00025000
  26. * DC CL8' ' FILETYPE 00026000
  27. * DC CL2' ' FILEMODE 00027000
  28. * DC H' ' ITEM NUMBER OF RECORD TO BE WRITTEN 00028000
  29. * DC A( ) ADDRESS OF OUTPUT BUFFER 00029000
  30. * DC F' ' NUMBER OF BYTES TO BE WRITTEN 00030000
  31. * DC CL2' ' F/V FLAG (IN LEFTMOST BYTE) 00031000
  32. * DC H' ' NUMBER OF ITEMS TO BE WRITTEN 00032000
  33. * 00033000
  34. * EXIT CONDITIONS: 00034000
  35. * 00035000
  36. * NORMAL - 00036000
  37. * R15 = 0 (AND CONDITION-CODE = 0) 00037000
  38. * 00038000
  39. * ERROR - 00039000
  40. * R15 NONZERO (AND CONDITION-CODE = 2) 00040000
  41. * 00041000
  42. * ERROR RETURNS: 00042000
  43. * 00043000
  44. * ERROR RETURNS TO CALLER (R15 VALUE AT EXIT): 00044000
  45. * 00045000
  46. * 2. USER MEMORY ADDRESS = 0 00046000
  47. * 00047000
  48. * 4. FIRST CHARACTER MODE ILLEGAL 00048000
  49. * 00049000
  50. * 5. SECOND CHARACTER MODE ILLEGAL 00050000
  51. * 00051000
  52. * 6. ITEM NUMBER + NUMBER OF ITEMS TOO LARGE--WILL NOT FIT 00052000
  53. * IN A HALFWORD 00053000
  54. * 00054000
  55. * 7. ATTEMPT TO SKIP OVER UNWRITTEN VARIABLE-LENGTH ITEM 00055000
  56. * 00056000
  57. * 8. NUMBER OF BYTES NOT SPECIFIED 00057000
  58. * 00058000
  59. * 9. FILE ALREADY ACTIVE FOR READING 00059000
  60. * 00060000
  61. * 10. MAXIMUM NUMBER OF CMS FILES (3400) REACHED 00061000
  62. * 00062000
  63. * 11. F-V FLAG NOT F OR V 00063000
  64. * 00064000
  65. * 12. MODE SY (SYSTEM) OR OTHER READ-ONLY DISK 00065000
  66. * 00066000
  67. * 13. DISK IS FULL (NON-FATAL) 00067000
  68. * 00068000
  69. * 14. NUMBER OF BYTES TO BE WRITTEN IS NOT INTEGRALLY 00069000
  70. * DIVISIBLE BY NUMBER OF ITEMS TO BE WRITTEN 00070000
  71. * 00071000
  72. * 15. LENGTH THIS ITEM NOT SAME AS PREVIOUS 00072000
  73. * 00073000
  74. * 16. CHARACTERISTIC (F-V FLAG) NOT SAME AS PREVIOUS 00074000
  75. * 00075000
  76. * 17. VARIABLE-LENGTH ITEM GREATER THAN 65K BYTES 00076000
  77. * 00077000
  78. * 18. NUMBER OF ITEMS GREATER THAN 1 FOR VARIABLE-LENGTH FILE 00078000
  79. * 00079000
  80. * 19. MAXIMUM NUMBER OF DATA BLOCKS PER FILE (16060) REACHED 00080000
  81. * 00081000
  82. * 20. INVALID CHARACTER(S) IN FILENAME (OF NEW FILE) 00082000
  83. * 00083000
  84. * 21. INVALID CHARACTER(S) IN FILETYPE (OF NEW FILE) 00084000
  85. * 00085000
  86. * 22. VIRTUAL STORAGE CAPACITY EXCEEDED 00086000
  87. * 00087000
  88. * 00088000
  89. * 25. INSUFFICIENT FREE STORAGE AVAILABLE FOR FILE 00089000
  90. * MANAGEMENT CONTROL AREAS. 00090000
  91. * 00090100
  92. * 27. ATTEMPT TO UPDATE VARIABLE LENGTH ITEM WITH ONE OF DIFFERENT 00090200
  93. * LENGTH 00090300
  94. * CALLS TO OTHER ROUTINES: 00091000
  95. * 00092000
  96. * ACTFREE, ACTFRET, ACTLKP, ADTLKP, DISKDIE, FREE, FRET, 00093000
  97. * FSTLKW, KILLEXF, QQTRK, QQTRKX, RDTK, TRKLKP, 00094000
  98. * TRKLKPX, WRTK 00095000
  99. * 00096000
  100. * EXTERNAL REFERENCES: 00097000
  101. * 00098000
  102. * ADT, AFT, FSTB, FVS 00099000
  103. * 00100000
  104. * TABLES/WORKAREAS: 00101000
  105. * 00102000
  106. * SEE EXTERNAL REFERENCES 00103000
  107. * 00104000
  108. * REGISTER USAGE: 00105000
  109. * 00106000
  110. * GRPO - BASE REGISTERS 00107000
  111. * 00108000
  112. * NOTES: 00109000
  113. * 00110000
  114. * NONE 00111000
  115. * 00112000
  116. * OPERATION: 00113000
  117. * 00114000
  118. * WRBUF FIRST PERFORMS A SERIES OF TESTS TO ENSURE THAT 00115000
  119. * THE PARAMETER LIST IS LEGAL. IF IT IS NOT, WRBUF 00116000
  120. * SIGNALS THE ERROR AND RETURNS TO THE CALLING PROGRAM. 00117000
  121. * IF THE PARAMETER IS LEGAL, WRBUF CALLS THE ACTLKP 00118000
  122. * ROUTINE TO SEE IF THE FILE EXISTS AND IS ACTIVE; IF 00119000
  123. * YES, PROCESSING PROCEEDS AS DESCRIBED UNDER "FILE 00120000
  124. * ACTIVE". IF NOT, WRBUF CALLS THE FSTLKW FUNCTION 00121000
  125. * PROGRAM TO DETERMINE WHETHER THE SPECIFIED FILE 00122000
  126. * EXISTS. IF YES, PROCESSING PROCEEDS AS DESCRIBED 00123000
  127. * UNDER "FILE EXISTS, NOT ACTIVE". IF NOT, PROCESSING 00124000
  128. * PROCEEDS AS DESCRIBED UNDER "FILE DOES NOT EXIST". 00125000
  129. * 00126000
  130. * FILE DOES NOT EXIST: 00127000
  131. * 00128000
  132. * IF THE FILE DOES NOT EXIST, WRBUF CALLS ADTLKP TO 00129000
  133. * DETERMINE THE ACTIVE DISK TABLE PERTAINING TO THE 00130000
  134. * GIVEN MODE, AND CHECKS TO ENSURE THAT THE DISK IS 00131000
  135. * AVAILABLE AND IN READ-WRITE STATUS (ERROR RETURN IF 00132000
  136. * NOT). THEN ACTFREE IS CALLED TO OBTAIN AN AVAILABLE 00133000
  137. * SLOT IN THE ACTIVE FILE TABLE FOR THE FILE ABOUT TO 00134000
  138. * BE CREATED. THEN WRBUF INITIALIZES THE AFT ENTRY 00135000
  139. * WITH NECESSARY INFORMATION INCLUDING THE NAME, TYPE, 00136000
  140. * AND MODE OF THE FILE. WRBUF THEN CALLS THE QQTRK 00137000
  141. * ROUTINE TO OBTAIN AN AVAILABLE SIXTEENTH OF A TRACK 00138000
  142. * OF DISK SPACE FOR USE AS THE FIRST CHAIN LINK AND 00139000
  143. * STORES THE DISK ADDRESS RETURNED BY QQTRK IN THE FILE 00140000
  144. * STATUS TABLE. NEXT, WRBUF CALCULATES (FROM THE ITEM 00141000
  145. * NUMBER SUPPLIED IN THE PARAMETER LIST) THE DATA BLOCK 00142000
  146. * INTO WHICH THE ITEM(S) IS/ARE TO BE WRITTEN. THIS 00143000
  147. * CALCULATION ALSO YIELDS THE LOCATION WITHIN THE DATA 00144000
  148. * BLOCK AT WHICH THE ITEM(S) WILL RESIDE. (THE 00145000
  149. * CALCULATION IS ((N-1)*L)/800. N IS THE ITEM NUMBER, L 00146000
  150. * IS THE ITEM LENGTH, AND 800 IS THE LENGTH OF A DATA 00147000
  151. * BLOCK. THE QUOTIENT PRODUCED BY THIS CALCULATION IS 00148000
  152. * THE NUMBER OF THE AFFECTED DATA BLOCK AND THE 00149000
  153. * REMAINDER IS THE DISPLACEMENT INTO THE DATA BLOCK AT 00150000
  154. * WHICH THE ITEM(S) WILL RESIDE.) NEXT, WRBUF 00151000
  155. * CALCULATES THE NUMBER OF BYTES TO BE WRITTEN. THIS 00152000
  156. * IS EQUAL TO THE ITEM LENGTH MULTIPLIED BY THE NUMBER 00153000
  157. * OF ITEMS TO BE WRITTEN. BOTH VALUES ARE OBTAINED 00154000
  158. * FROM THE PARAMETER LIST. WRBUF THEN MARKS THE FILE 00155000
  159. * ACTIVE, OBTAINS BUFFER SPACE FOR THE DATA BLOCK, AND 00156000
  160. * DETERMINES IF THE ITEM TO BE WRITTEN IS OF FIXED OR 00157000
  161. * VARIABLE LENGTH. IF OF VARIABLE LENGTH, PROCESSING 00158000
  162. * PROCEEDS AS DESCRIBED UNDER "VARIABLE-LENGTH ITEM". 00159000
  163. * IF OF FIXED LENGTH, PROCESSING PROCEEDS AS DESCRIBED 00160000
  164. * BELOW. 00161000
  165. * 00162000
  166. * FIXED-LENGTH ITEM: WRBUF DETERMINES THE CHAIN LINK 00163000
  167. * THAT SHOULD CONTAIN THE ADDRESS OF THE AFFECTED DATA 00164000
  168. * BLOCK. (ORDINARILY, AT THIS POINT, THIS WILL BE THE 00165000
  169. * FIRST CHAIN LINK AND IT WILL EXIST IN MAIN STORAGE.) 00166000
  170. * IF THIS CHAIN LINK DOES NOT EXIST (THAT IS, ITS 00167000
  171. * CORRESPONDING ENTRY IN THE FIRST CHAIN LINK IS NOT A 00168000
  172. * VALID DISK ADDRESS), WRBUF CALLS THE TRKLKP FUNCTION 00169000
  173. * PROGRAM TO OBTAIN A QUARTER OF A TRACK FOR THE NEW 00170000
  174. * CHAIN LINK, INSERTS THE DISK ADDRESS RETURNED BY 00171000
  175. * TRKLKP INTO THE CHAIN LINK DIRECTORY OF THE ACTIVE 00172000
  176. * FILE TABLE ENTRY, AND OBTAINS STORAGE FOR USE IN 00173000
  177. * CONSTRUCTING THE NEW CHAIN LINK. IF THE CHAIN LINK 00174000
  178. * EXISTS, WRBUF CALLS THE RDTK FUNCTION PROGRAM TO READ 00175000
  179. * IT INTO MAIN STORAGE. WRBUF THEN DETERMINES IF THE 00176000
  180. * AFFECTED DATA BLOCK EXISTS. (IT WILL IF THE 00177000
  181. * CORRESPONDING ENTRY IN THE CHAIN LINK THAT IS IN MAIN 00178000
  182. * STORAGE CONTAINS A VALID DISK ADDRESS.) IF IT DOES 00179000
  183. * NOT EXIST, WRBUF CALLS THE TRKLKP FUNCTION PROGRAM TO 00180000
  184. * OBTAIN A QUARTER OF A TRACK FOR THE NEW DATA BLOCK, 00181000
  185. * INSERTS THE DISK ADDRESS RETURNED BY TRKLKP INTO THE 00182000
  186. * APPROPRIATE ENTRY IN THE CHAIN LINK THAT IS IN MAIN 00183000
  187. * STORAGE, AND CLEARS THE DATA BLOCK BUFFER FOR USE IN 00184000
  188. * CONSTRUCTING THE DATA BLOCK. IF THE DATA BLOCK 00185000
  189. * EXISTS, WRBUF CALLS THE RDTK FUNCTION PROGRAM TO READ 00186000
  190. * IT INTO THE DATA BLOCK BUFFER. WRBUF THEN CALCULATES 00187000
  191. * THE NUMBER OF BYTES IN THE DATA BLOCK BUFFER THAT ARE 00188000
  192. * AVAILABLE FOR USE. (THE NUMBER OF BYTES AVAILABLE IS 00189000
  193. * EQUAL TO 800 MINUS THE PREVIOUSLY CALCULATED 00190000
  194. * DISPLACEMENT.) NEXT, WRBUF DETERMINES WHETHER THE 00191000
  195. * NUMBER OF BYTES TO BE WRITTEN IS GREATER THAN THE 00192000
  196. * NUMBER OF BYTES AVAILABLE IN THE DATA BLOCK BUFFER. 00193000
  197. * IF THE NUMBER OF BYTES TO BE WRITTEN IS NOT GREATER 00194000
  198. * THAN THE NUMBER AVAILABLE, WRBUF MOVES THE BYTES TO 00195000
  199. * BE WRITTEN FROM THE INPUT BUFFER TO THE BLOCK BUFFER 00196000
  200. * AND RETURNS TO THE CALLING PROGRAM. (IN THIS CASE, 00197000
  201. * THE DATA BLOCK IS NOT WRITTEN ONTO DISK BECAUSE IT IS 00198000
  202. * NOT FULL.) IF THE NUMBER OF BYTES TO BE WRITTEN 00199000
  203. * EXCEEDS THE NUMBER OF BYTES AVAILABLE, WRBUF MOVES 00200000
  204. * SUFFICIENT BYTES INTO THE DATA BLOCK BUFFER TO FILL 00201000
  205. * IT, AND WRITES THE COMPLETED DATA BLOCK ONTO DISK. 00202000
  206. * WRBUF THEN DETERMINES IF THE CHAIN LINK THAT SHOULD 00203000
  207. * CONTAIN THE ADDRESS OF THE DATA BLOCK THAT IS TO 00204000
  208. * RECEIVE THE OVERFLOW FROM THE PREVIOUS DATA BLOCK IS 00205000
  209. * IN MAIN STORAGE. IF IT IS NOT, WRBUF WRITES THE 00206000
  210. * CURRENT CHAIN LINK (THAT IS, THE ONE IN MAIN STORAGE) 00207000
  211. * ONTO DISK AND RETRIEVES THE CHAIN LINK CONTAINING THE 00208000
  212. * ADDRESS OF THE DATA BLOCK THAT IS TO RECEIVE THE 00209000
  213. * OVERFLOW. THIS CHAIN LINK MAY OR MAY NOT EXIST. IF 00210000
  214. * THE CHAIN LINK DOES NOT EXIST, WRBUF ALLOCATES DISK 00211000
  215. * SPACE FOR THE NEW CHAIN LINK IN THE PREVIOUSLY 00212000
  216. * DESCRIBED MANNER AND DETERMINES IF THE DATA BLOCK 00213000
  217. * THAT IS TO RECEIVE THE OVERFLOW EXISTS AS PREVIOUSLY 00214000
  218. * DESCRIBED. IF THE CHAIN LINK EXISTS, WRBUF READS IT 00215000
  219. * INTO MAIN STORAGE AND DETERMINES IF THE DATA BLOCK TO 00216000
  220. * RECEIVE THE OVERFLOW EXISTS. WHEN THE DATA BLOCK 00217000
  221. * THAT IS TO RECEIVE THE OVERFLOW IS IN MAIN STORAGE, 00218000
  222. * (THAT IS, IN THE DATA BLOCK BUFFER) WRBUF CALCULATES 00219000
  223. * THE NUMBER OF BYTES REMAINING TO BE WRITTEN. IF THIS 00220000
  224. * IS NOT GREATER THAN THE NUMBER OF BYTES AVAILABLE IN 00221000
  225. * THE DATA BLOCK BUFFER (ON OVERFLOW, ALL 800 BYTES OF 00222000
  226. * THE DATA BLOCK BUFFER ARE AVAILABLE), WRBUF MOVES THE 00223000
  227. * REMAINING BYTES FROM THE INPUT BUFFER TO THE DATA 00224000
  228. * BLOCK BUFFER AND RETURNS TO THE CALLER. IF THE 00225000
  229. * NUMBER OF BYTES REMAINING TO BE WRITTEN IS GREATER 00226000
  230. * THAN THE NUMBER OF BYTES AVAILABLE IN THE DATA BLOCK 00227000
  231. * BUFFER, WRBUF MOVES SUFFICIENT BYTES INTO THE DATA 00228000
  232. * BLOCK BUFFER TO FILL IT, WRITES THE DATA BLOCK ONTO 00229000
  233. * DISK, AND MOVES THE OVERFLOW INTO THE NEXT DATA BLOCK 00230000
  234. * AS DESCRIBED. 00231000
  235. * 00232000
  236. * VARIABLE-LENGTH ITEM: WRBUF READS SUCCESSIVE DATA 00233000
  237. * BLOCKS (STARTING WITH THE FIRST) INTO THE DATA BLOCK 00234000
  238. * BUFFER UNTIL IT LOCATES THE ONE THAT CONTAINS THE 00235000
  239. * ITEM IMMEDIATELY PRECEDING THE ONE THAT CORRESPONDS 00236000
  240. * TO THE ITEM NUMBER SPECIFIED IN THE PARAMETER LIST. 00237000
  241. * IT THEN LOCATES THE END OF THAT ITEM. (THIS MAY 00238000
  242. * ENTAIL READING ADDITIONAL DATA BLOCKS, DEPENDING ON 00239000
  243. * THE LENGTH OF THE ITEM.) WHEN IT LOCATES THE END OF 00240000
  244. * THE ITEM, WRBUF MOVES THE LENGTH OF THE ITEM TO BE 00241000
  245. * WRITTEN FROM THE INPUT BUFFER TO THE LOCATION IN THE 00242000
  246. * DATA BLOCK BUFFER IMMEDIATELY AFTER THE END OF THE 00243000
  247. * PREVIOUS ITEM. IT THEN MOVES THE ITEM TO BE WRITTEN 00244000
  248. * FROM THE INPUT BUFFER TO THE DATA BLOCK BUFFER IN THE 00245000
  249. * SAME MANNER AS FOR FIXED-LENGTH ITEMS. (IF OVERFLOW 00246000
  250. * OCCURS, IT IS HANDLED IN THE SAME MANNER AS FOR 00247000
  251. * FIXED-LENGTH ITEMS.) 00248000
  252. * 00249000
  253. * FILE EXISTS, NOT ACTIVE: 00250000
  254. * 00251000
  255. * IF THE FILE EXISTS BUT IS NOT ACTIVE, WRBUF 00252000
  256. * CALCULATES THE DATA BLOCK INTO WHICH THE ITEM(S) IS 00253000
  257. * TO BE WRITTEN. THIS CALCULATION ALSO YIELDS THE 00254000
  258. * LOCATION WITHIN THE DATA BLOCK AT WHICH THE ITEM(S) 00255000
  259. * WILL RESIDE. ACTFREE IS CALLED TO OBTAIN AN 00256000
  260. * AVAILABLE SLOT IN THE ACTIVE FILE TABLE AND TO STORE 00257000
  261. * THE FST ENTRY THEREIN. NEXT, WRBUF MARKS THE FILE AS 00258000
  262. * ACTIVE, READS THE FIRST CHAIN LINK INTO MAIN STORAGE, 00259000
  263. * AND MOVES THE FIRST 80 BYTES OF THE FIRST CHAIN LINK 00260000
  264. * INTO THE CHAIN LINK DIRECTORY OF THE ACTIVE FILE 00261000
  265. * TABLE ENTRY. WRBUF THEN DETERMINES IF THE ITEM(S) TO 00262000
  266. * BE WRITTEN ARE OF FIXED OR VARIABLE LENGTH. FOR BOTH 00263000
  267. * OF THESE ITEM TYPES, WRBUF PROCEEDS AS DESCRIBED 00264000
  268. * UNDER THE CORRESPONDING HEADING IN "FILE DOES NOT 00265000
  269. * EXIST" IN THIS SECTION. 00266000
  270. * 00267000
  271. * FILE ACTIVE: 00268000
  272. * 00269000
  273. * IF THE FILE IS ACTIVE, WRBUF CALCULATES THE DATA 00270000
  274. * BLOCK INTO WHICH THE ITEM(S) IS/ARE TO BE WRITTEN. 00271000
  275. * THIS CALCULATION ALSO YIELDS THE DISPLACEMENT INTO 00272000
  276. * THE DATA BLOCK AT WHICH THE ITEM(S) WILL RESIDE. 00273000
  277. * NEXT, WRBUF DETERMINES THE NATURE OF THE ITEM(S) TO 00274000
  278. * BE WRITTEN. IF OF VARIABLE LENGTH, WRBUF PROCEEDS AS 00275000
  279. * DESCRIBED UNDER "VARIABLE-LENGTH ITEM". IF OF FIXED 00276000
  280. * LENGTH, IT PROCEEDS AS DESCRIBED BLOW. 00277000
  281. * 00278000
  282. * FIXED-LENGTH ITEM: WRBUF DETERMINES WHETHER THE 00279000
  283. * AFFECTED DATA BLOCK IS IN MAIN STORAGE. IF IT IS, 00280000
  284. * WRBUF PROCEEDS AS DESCRIBED UNDER "FILE DOES NOT 00281000
  285. * EXIST", STARTING AT THE POINT WHERE THE NUMBER OF 00282000
  286. * BYTES AVAILABLE IN THE DATA BLOCK BUFFER IS 00283000
  287. * CALCULATED. IF THE AFFECTED DATA BLOCK IS NOT IN MAIN 00284000
  288. * STORAGE, WRBUF PROCEEDS IN ESSENTIALLY THE SAME 00285000
  289. * MANNER AS DESCRIBED UNDER "FILE DOES NOT EXIST", 00286000
  290. * STARTING AT THE POINT WHERE THE DATA BLOCK IS WRITTEN 00287000
  291. * ONTO DISK. (IN THIS CASE, AN OVERFLOW CONDITION IS 00288000
  292. * NOT BEING PROCESSED; HOWEVER, THE LOGIC USED TO 00289000
  293. * OBTAIN THE AFFECTED CHAIN LINK AND DATA BLOCK IS 00290000
  294. * ESSENTIALLY THE SAME. ALSO, BECAUSE THIS IS NOT AN 00291000
  295. * OVERFLOW CONDITION, WHEN THE AFFECTED DATA BLOCK IS 00292000
  296. * RESIDENT IN THE DATA BLOCK BUFFER, THE NUMBER OF 00293000
  297. * BYTES AVAILABLE IN THAT BUFFER IS EQUAL TO 800 MINUS 00294000
  298. * THE CALCULATED DISPLACEMENT.) 00295000
  299. * 00296000
  300. * VARIABLE-LENGTH ITEM: IF THE VARIABLE-LENGTH ITEM TO 00297000
  301. * BE WRITTEN IMMEDIATELY FOLLOWS THE ONE THAT WAS JUST 00298000
  302. * PROCESSED, WRBUF MOVES THE ITEM LENGTH FROM THE INPUT 00299000
  303. * BUFFER INTO THE DATA BLOCK BUFFER IMMEDIATELY AFTER 00300000
  304. * THE END OF THE PREVIOUS ITEM. IT THEN MOVES THE ITEM 00301000
  305. * TO BE WRITTEN FROM THE INPUT BUFFER INTO THE DATA 00302000
  306. * BLOCK BUFFER IMMEDIATELY AFTER THE LENGTH. THIS IS 00303000
  307. * DONE IN THE USUAL MANNER. (IF OVERFLOW OCCURS, IT IS 00304000
  308. * HANDLED IN THE USUAL MANNER.) IF THE ITEM TO BE 00305000
  309. * WRITTEN DOES NOT IMMEDIATELY FOLLOW THE ONE THAT WAS 00306000
  310. * JUST PROCESSED, WRBUF PROCEEDS IN THE SAME MANNER AS 00307000
  311. * DESCRIBED UNDER THE VARIABLE-LENGTH ITEM PORTION OF 00308000
  312. * "FILE DOES NOT EXIST". 00309000
  313. * 00310000
  314. * NOTES: 00311000
  315. * 00312000
  316. * 1. WRBUF CAN ONLY WRITE A CERTAIN NUMBER OF LOGICAL 00313000
  317. * RECORDS OR ITEMS, REGARDLESS OF HOW MUCH DISK 00314000
  318. * SPACE MAY BE AVAILABLE, BECAUSE THE "NUMBER OF 00315000
  319. * ITEMS" IS KEPT IN A HALFWORD IN THE 40-BYTE FST 00316000
  320. * ENTRY FOR THAT FILE, AND IS LIMITED BY THE SIZE OF 00317000
  321. * A NUMBER WHICH WILL FIT IN A (16-BIT) HALFWORD. 00318000
  322. * TO AVOID RUNNING INTO THIS LIMITATION BEFORE IT IS 00319000
  323. * TOO LATE TO CLOSE THE FILE SUCCESSFULLY, WRBUF 00320000
  324. * CHECKS THAT THE ITEM-NUMBER (WHEN A WRBUF CALL HAS 00321000
  325. * BEEN COMPLETED) WILL NOT EXCEED A GIVEN LIMIT. IF 00322000
  326. * IT DOES, AN ERROR CODE 6 IS RETURNED, AND NO MORE 00323000
  327. * DATA IS WRITTEN. THE FILE MAY, HOWEVER, AT THIS 00324000
  328. * POINT BE SUCCESSFULLY CLOSED (VIA FINIS), AND CAN 00325000
  329. * LATER BE READ BY RDBUF. AT PRESENT THIS LIMITING 00326000
  330. * NUMBER OF RECORDS HAPPENS TO BE 65533. (65533 00327000
  331. * WOULD HAVE BEEN THE ABSOLUTE LIMITING FACTOR.) 00328000
  332. * 00329000
  333. * 2. IN CALLS TO QQTRK FOR OBTAINING THE FIRST CHAIN 00330000
  334. * LINK FOR A NEW FILE, AND TO TRKLKP FOR OBTAINING 00331000
  335. * EITHER A NEW NTH CHAIN LINK OR A DATA BLOCK, ERROR 00332000
  336. * CODES ARE CHECKED FROM THESE FUNCTION PROGRAMS FOR 00333000
  337. * THE FULL DISK CONDITION. IF ANY OF THESE 00334000
  338. * SITUATIONS OCCUR, WRBUF CAREFULLY SETS OR RESETS 00335000
  339. * ANY FLAGS OR CONDITIONS AS NEEDED, AND PRESENTS 00336000
  340. * THE USER WITH THE NON-FATAL ERROR-CODE 13. 00337000
  341. * THE FILE WHICH WAS BEING WRBUF'ED (UNLESS 00338000
  342. * NULL) IS THEN AVAILABLE AND COMPLETE INSOFAR AS 00339000
  343. * THE DATA BEING WRITTEN COULD FIT IN THE SPACE 00340000
  344. * AVAILABLE. THE DIRECTORY IS NOT UPDATED UNLESS A 00341000
  345. * KX IS IN EFFECT, THUS ALLOWING ANY DESIRED ERROR 00342000
  346. * RECOVERY PROCEDURES TO BE INSTITUTED. 00343000
  347. * 00344000
  348. * 3. BECAUSE OF THE DESIGN OF THE FIRST CHAIN LINK IN 00345000
  349. * THE CMS FILE SYSTEM, THERE IS A LIMITATION OF 00346000
  350. * 16060 800-BYTE DATA BLOCKS FOR ANY GIVEN FILE. IF 00347000
  351. * A FILE BEING WRBUF'ED REACHES THIS LIMIT, AN ERROR 00348000
  352. * 19 IS RETURNED, AND NO MORE DATA IS WRITTEN. THE 00349000
  353. * FILE MAY BE CLOSED, AND CAN THEN BE SUCCESSFULLY 00350000
  354. * READ (OR ERASED), BUT IT CANNOT BE MADE ANY 00351000
  355. * LARGER. (A FILE OF THIS SIZE WOULD FILL MORE THAN 00352000
  356. * HALF OF A FULL-SIZE 2314 DISK). 00353000
  357. * 00354000
  358. * 4. THERE IS ALSO A LIMIT OF 3400 FILES THAT CAN BE 00355000
  359. * REPRESENTED FOR ANY GIVEN DISK, AS LIMITED BY THE 00356000
  360. * LAYOUT OF THE MFD BLOCK. IF A DISK ALREADY HAS 00357000
  361. * REACHED THIS MAXIMUM AND AN ATTEMPT TO WRBUF A NEW 00358000
  362. * FILE IS MADE, WRBUF RETURNS AN ERROR CODE 10, AND 00359000
  363. * THE NEW FILE IS NOT OPENED. 00360000
  364. * 00361000
  365. *. 00362000
  366. EJECT 00363000
  367. DMSBWR START 0 (NOTE - CAN BE CALLED BY BALR WITHIN NUCLEUS) 00364000
  368. ENTRY WRBUF 00365000
  369. WRBUF EQU DMSBWR 00366000
  370. * 00367000
  371. ENTRY INVTBL 00368000
  372. * 00369000
  373. * ENTER 'WRBUF', SAVE REGISTERS, SET UP ADDRESSABILITY, ETC. 00370000
  374. USING NUCON,R0 00371000
  375. L R15,AFVS -- A(FVS) INTO R15 00372000
  376. USING FVSECT,R15 00373000
  377. STM R0,R14,REGSAV3 -- SAVE R0 THRU 14 00374000
  378. DROP R15 00375000
  379. LR R13,R15 -- REFERENCE 'FVS' INFO 00376000
  380. USING FVSECT,R13 00377000
  381. BALR R10,0 -- OUR OWN ADDRESSABILITY 00378000
  382. USING *,R10 00379000
  383. OI UFDBUSY,WRBIT SET OUR BIT IN 'UFDBUSY' FLAG 00380000
  384. LA R1,0(,R1) MAKE THE REGISTER PRESENTABLE 00381000
  385. LM R2,R3,PADDR(R1) CHECK ADDRESS (& BYTE-COUNT INTO R3) 00382000
  386. LR R11,R1 AND MAKE A COPY. V0510 00383000
  387. SR R8,R8 EMPTY A REGISTER. V0510 00384000
  388. ICM R8,B'0011',PNOIT(R1) GET THE NUMBER OF ITEMS. V0510 00385000
  389. LA R2,0(,R2) STRIP OFF HIGH ORDER BYTE. 00386000
  390. LTR 2,2 00387000
  391. LA R15,2 ERROR 2 00388000
  392. BZ ERR IF = 0. 00389000
  393. ST 2,PADDRX SAVE PADDR 00390000
  394. LTR R6,R3 REMEMBER BYTE COUNT, & CHECK IT; @VA01100 00391000
  395. LA R15,8 ERROR 8 IF 00392000
  396. BNP ERR NOT > 0. 00393000
  397. LA R15,0(R2,R3) COMPUTE END OF DATA @VM03232 00394000
  398. C R15,VMSIZE COMPARE WITH VMSIZE @VM03232 00395000
  399. BNH BUFOK GO TO IT @VA10561 00396000
  400. CLC VMSIZE+1(3),SVCOPSW+5 DCSS USER..?? @VA10561 00396200
  401. BH ERROR22 NO KILL HIM (RC=2) @VA10561 00396400
  402. BUFOK EQU * @VA10561 00396600
  403. LA R7,1 1 INTO R7 FOR GENERAL USE (FOR A WHILE) 00397000
  404. SR R0,R0 0 INTO R0, 00398000
  405. ST R0,FALIGN CLEAR 'FALIGN', 00399000
  406. CR R0,R8 PNOIT > 0? V0510 00400000
  407. BL TSTFVF BL IF OK, NO. OF ITEMS IS > 0. 00401000
  408. STH R7,PNOIT(,R1) SET NOIT = 1 (IF IT WAS 0) 00402000
  409. LR R8,R7 READJUST THE SAVED COPY. V0510 00403000
  410. SPACE 1 00404000
  411. TSTFVF EQU * 00405000
  412. CLI PFIVA(1),C'F' TEST F-V 00406000
  413. BE FVF 00407000
  414. CLI PFIVA(1),C'V' 00408000
  415. LA R15,11 ERROR 11 00409000
  416. BNE ERR IF NOT = V. 00410000
  417. CR R7,R8 MUST BE 1 FOR VARIABLE FILES. V0510 00411000
  418. LA R15,18 ERROR 18 00412000
  419. BNE ERR IF NOT = 1. 00413000
  420. C R3,=F'65535' CHECK AGAINST MAX(ALLOWABLE) V0510 00414000
  421. LA R15,17 ERROR 17 00415000
  422. BH ERR IF > 65535. 00416000
  423. FVF CLI PMODE(R1),C'A' MODE LETTER MUST BE SPECIFICALLY GIVEN 00417000
  424. BL ERROR4 ERROR 4 IF < A 00418000
  425. CLI PMODE(R1),C'Z' ... 00419000
  426. BH ERROR4 OR ERROR 4 IF > Z 00420000
  427. CLI PFILE(R1),C'*' ASTERISK IN FILENAME ? @VM03232 00421000
  428. BE ERROR20 THAT'S ILLEGAL ... @VM03232 00422000
  429. CLI PTYPE(R1),C'*' OR ASTERISK IN FILETYPE ? @VM03232 00423000
  430. BE ERROR21 THAT'S IMMORAL OR FATTENING. @VM03232 00424000
  431. LR R3,R8 MAKE A USEFUL COPY OF PNOIT. V0510 00425000
  432. SR R4,R4 ZERO-OUT REGISTER 4 V0510 00426000
  433. ICM R4,B'0011',PITEM(R1) GET THE STARTING ITEM-NUMBV0510 00427000
  434. BZ LR15AA (FORGET IT IF = 0) 00428000
  435. AR R3,R4 COMPUTE ITEM-NUMBER WE WILL HAVE 00429000
  436. C R3,=F'65535' CHECK AGAINST MAX(ALLOWABLE). V0510 00430000
  437. BNL ERROR6 ERROR IF > PRACTICAL LIMIT OF 65533 00431000
  438. LR R3,R8 GET PNOIT. V0510 00432000
  439. LR15AA L R15,AACTLKP GET ADDR OF AFT-LOOKUP. V0510 00433000
  440. BALR R14,R15 (R0 = 0 TO SEARCH FROM BEGINNING) 00434000
  441. BZ FOUND1 BZ IF FOUND BY ACTLKP. 00435000
  442. SR99 SR R9,R9 R9=0 MEANS NOT FOUND BY ACTLKP 00436000
  443. L 15,=V(DMSLFSW) CALL 'FSTLKW', THEN 00437000
  444. BALR 14,15 ... 00438000
  445. LR R12,R1 R1 INTO R12 IN CASE IT WAS SUCCESSFUL, 00439000
  446. BZ FOUND2 BRANCH IF C.C. = 0 (WAS FOUND) @VM03232 00440000
  447. CK LA R1,8(,R11) POINT TO FILE NAME HRC012DS 00441490
  448. BAL R15,PTEST CHECK FILENAME FOR INVALID CHARS @VA01100 00442000
  449. BZ CKTYP FILENAME WAS GOOD, SO HOW WAS FILETYPE 00443000
  450. ERROR20 LA R15,20 TELL HIM HIS FILENAME WAS BAD @VM03232 00444000
  451. B ERR ... 00445000
  452. CKTYP LA R1,16(,R11) POINT TO FILE TYPE HRC012DS 00446490
  453. BAL R15,PTEST CHECK THE FILETYPE. 00447000
  454. BZ PLOK PASSED THIS TEST TOO. 00448000
  455. ERROR21 LA R15,21 TELL HIM HIS FILETYPE WAS BAD @VM03232 00449000
  456. B ERR ... 00450000
  457. PLOK L R2,PADDRX RESTORE WHAT WE CLOBBERED 00451000
  458. LR R1,R11 RESTORE R1 TO PARAMETER-LIST, 00452000
  459. L R15,=V(DMSLAD) CALL 'ADTLKP' TO FIND DISK TO WRITE ON, 00453000
  460. BALR R14,R15 ... 00454000
  461. BNZ ERROR4 ERROR 4 IF NO DISK AT ALL MATCHING THIS LETTER 00455000
  462. CLI PMODE+1(R11),C' ' WAS NO MODE NUMBER SPECIFIED??@VA05746 00456000
  463. BNE CHKMD YES THERE WAS - CHECK IF ILLEGAL @VA05746 00457000
  464. MVI PMODE+1(R11),C'1' DEFAULT MODE NUMBER TO 1 @VA05746 00458000
  465. CHKMD DS 0H @VA05746 00459000
  466. CLI PMODE+1(R11),C'0' IS MODE NUMBER LEGAL? 00460000
  467. BL ERROR5 BRANCH IF NOT 00461000
  468. CLI PMODE+1(R11),C'6' ARE WE SURE? 00462000
  469. BNL ERROR5 BRANCH IF > 5 (NO GOOD) @VA01100 00463000
  470. USING ADTSECT,R1 IF FOUND, REFERENCE ACTIVE-DISK-TABLE, 00464000
  471. TM ADTFLG1,ADTFRW IT BETTER BE A READ-WRITE DISK, 00465000
  472. BZ CANTWRIT ERROR IF IT ISN'T. 00466000
  473. L R0,ADTFSTC TOTAL NO. OF FILES ON THIS DISK 00467000
  474. CH R0,MAXFILES MAXIMUM NO? 00468000
  475. BNL FILSBUST BRANCH IF SO 00469000
  476. LR R0,R1 IF OK, PLACE IN R0 FOR ACTFREE SHORTLY, 00470000
  477. SR R1,R1 AND CLEAR R1 FOR ACTFREE. 00471000
  478. DROP R1 00472000
  479. CLI PFIVA(R11),C'F' FIXED FILE? @VA02521 00473000
  480. BE INIT YES - NO PROBLEM @VA02521 00474000
  481. LA R15,1 VARIABLE-STARTING ITEM NUMBER @VA02521 00475000
  482. CLM R15,B'0011',PITEM(R11) MUST NOT EXCEED 1 @VA02521 00476000
  483. BNL INIT OK IF 0 OR 1 @VA02521 00477000
  484. B ERROR7 ERROR7 IF 2 OR MORE @VA02521 00478000
  485. ERROR5 LA R15,5 ERROR 5 IF MODE NO. < 0 OR > 5. @VA01100 00479000
  486. B ERR ... 00480000
  487. * 00481000
  488. FOUND1 LR R9,R1 REFERENCE ACTIVE-FILE-TABLE, 00482000
  489. USING AFTSECT,R9 ... 00483000
  490. LA R12,AFTFST POINT R12 TO COPY OF FST BLOCK IN AFT BLOCK 00484000
  491. TM AFTFLG,AFTWRT ACTIVE-WRITE ? 00485000
  492. BO FOUND2 BO IF YES (GOOD SHOW), CONTINUE BELOW. 00486000
  493. TM AFTFLG,AFTRD ACTIVE-READ ? 00487000
  494. LA R15,9 ERROR 9 00488000
  495. BO ERR IF YES. 00489000
  496. L R1,AFTADT IF NEITHER (MUST BE FROM A 'POINT'), 00490000
  497. USING ADTSECT,R1 REFERENCE ACTIVE-DISK-TABLE 00491000
  498. TM ADTFLG1,ADTFRW IT BETTER BE A READ-WRITE DISK, 00492000
  499. BZ JCANTWRT MAKE SPECIAL CHECK IF IT ISN'T. 00493000
  500. DROP R1,R9 (FOR NOW) 00494000
  501. * 00495000
  502. USING FSTSECT,R12 (BRIEFLY) 00496000
  503. FOUND2 CLC FSTFV(1),PFIVA(R11) IS CHARACTERISTIC CORRECT 00497000
  504. LA R15,16 ERROR 16 00498000
  505. BNE ERR IF NOT CORRECT 00499000
  506. CLI FSTFV,C'V' IS IT VARIABLE LENGTH ITEM 00500000
  507. BE PROCES YES, DON'T WORRY ABOUT LENGTH 00501000
  508. L R2,FSTIL TEST NO. OF BYTES 00502000
  509. L R15,FSTIL GET ITEM LENGTH V0510 00503000
  510. MR R14,R8 GET SIZE OF REQUEST. V0510 00504000
  511. CR R15,R6 EQUAL TO PNOBY? V0510 00505000
  512. BE PROCES SAME AS BEFORE 00506000
  513. * 00507000
  514. LA R15,15 ERROR 15 IF WRONG 00508000
  515. B ERR NUMBER OF BYTES 00509000
  516. DROP R12 00510000
  517. SPACE 3 00511000
  518. PTEST DS 0H CHECK CHARACTER VALIDITY HRC012DS 00512690
  519. LA R5,7(,R1) PNT AT LAST BYTE OF NAME HRC012DS 00513380
  520. LR R0,R1 SAVE POINTER BEFORE TRT HRC012DS 00514070
  521. TRT 0(8,R1),INVTBL CHECK FOR INVALID CHARACTER HRC012DS 00514760
  522. BZR R15 IF ALL OK, EXIT WITH CC = 0. HRC012DS 00515450
  523. CR R0,R1 DID TRT ERROR AT FIRST CHAR HRC012DS 00516140
  524. BE SETCODE ERROR ON FIRST CHARACTER HRC012DS 00516830
  525. SR R5,R1 CHECK IF FIRST CHAR INVALID HRC012DS 00517520
  526. * SIZE IS -1 FOR EXECUTE INST HRC012DS 00518210
  527. BMR R15 TSK! TSK! BAD LIST HRC012DS 00518900
  528. EX R5,CLC CHECK THE REST FOR BLANKS HRC012DS 00519590
  529. BR R15 EXIT WITH CC SET 0 OR ¬0 HRC012DS 00520280
  530. SETCODE DS 0H SET A NON ZERO CONDITION CODE HRC012DS 00520970
  531. CR R15,R1 R15 = RETURN, R1 = PRAM LIST HRC012DS 00521660
  532. BR R15 RETURN TO CALLER WITH CC = 2 HRC012DS 00522350
  533. CLC CLC 0(0,R1),INVTBL CHECK FOR BLANKS IN NAME HRC012DS 00523040
  534. EJECT 00525000
  535. ******************************************************* 00526000
  536. * 00527000
  537. * OPEN NEW FILE WITH SPECIFIED FILE NAME, FILE TYPE. 00528000
  538. * ASSIGN ENTRY IN ACTIVE STATUS TABLE AND ASSIGN FIRST 00529000
  539. * CHAIN LINK. 00530000
  540. * 00531000
  541. **************************************************** 00532000
  542. * 00533000
  543. * NOTE : R11 ALREADY POINTS TO ORIGINAL P-LIST 00534000
  544. * (NEEDED BY 'ACTFREE') 00535000
  545. * 00536000
  546. INIT L R15,AACTFREE CALL 'ACTFREE' TO OPEN THE FILE 00537000
  547. BALR R14,R15 ... 00538000
  548. LR R9,R1 REFERENCE ACTIVE-FILE-TABLE 00539000
  549. USING AFTSECT,R9 ... 00540000
  550. MVC AFTN(16),PFILE(R11) MOVE IN FILENAME & FILETYPE 00541000
  551. XC AFTD(24),AFTD CLEAR FROM DATE THRU TO END OF 40-BYTES 00542000
  552. MVC AFTFV(1),PFIVA(R11) CHARACTERISTIC 00543000
  553. MVC AFTM(2),PMODE(R11) MODE, 00544000
  554. STH R7,AFTWP SET WRITE- AND 00545000
  555. STH R7,AFTRP READ-POINTERS TO 1 00546000
  556. LR R15,R6 GET PNOBY. V0510 00547000
  557. SR 14,14 ... 00548000
  558. DR R14,R3 CALCULATE INDIVIDUAL ITEM LENGTH 00549000
  559. LTR R15,R15 IS IT GREATER THAN ZERO? @VA04192 00550000
  560. BNP ERROR14 NO - ERROR @VA04192 00551000
  561. LTR R14,R14 WAS THERE A REMAINDER? @VA04192 00552000
  562. BZ SETITEM NO - ITEM LENGTH IS OK @VA04192 00553000
  563. ERROR14 LA R15,14 BUFFER SIZE NOT INTEGRALLY @VA04192 00554000
  564. B ERR DIVISIBLE BY # RECORDS TO WRITE @VA04192 00555000
  565. SETITEM ST R15,AFTIL SET ITEM LENGTH @VA04192 00556000
  566. STH R4,AFTIC STORE ITEM NO. (IF ANY) - STILL IN R4 00557000
  567. LR R1,R0 R1 MUST POINT TO ACTIVE DISK TABLE, 00558000
  568. LR R12,R1 REMEMBER ADDR ACTIVE DISK TABLE @VA01247 00559000
  569. L R15,AQQTRK AND CALL 'QQTRK' 00560000
  570. BALR R14,R15 TO OBTAIN FIRST CHAIN LINK 00561000
  571. BNZ QQBAD BAD NEWS IF ERROR FROM QQTRK 00562000
  572. STH R1,AFTFCL IF OK, RECORD DISK-ADD. OF 1ST CHAIN-LINK 00563000
  573. MVI AFTFLG2,AFTNEW FLAG AS TOTALLY NEW FILE. V0510 00564000
  574. USING ADTSECT,R12 REFERENCE ACTIVE DISK TABLE @VA01247 00565000
  575. L R15,ADTFSTC TOTAL NO. OF FILES ON THIS DISK @VA01247 00566000
  576. AR R15,R7 BUMP COUNT BY 1 (R7 STILL = 1) @VA01247 00567000
  577. ST R15,ADTFSTC AND STORE NEW VALUE @VA01247 00568000
  578. DROP R12 @VA01247 00569000
  579. LA R12,AFTFST POINT R12 TO COPY OF FST BLOCK IN AFT BLOCK 00570000
  580. * CONTINUE TO 'PROCES' ... 00571000
  581. EJECT 00572000
  582. *************************************************** 00573000
  583. * THE POSITION OF THE ITEM IN THE DATA BLOCK IS CALCULATED 00574000
  584. * IF THE CURRENT CHAIN LINK AND DATA BLOCK ARE CURRENTLY 00575000
  585. * IN CORE, THE ITEM IS INSERTED IN THE DATA BLOCK AND WRBUF 00576000
  586. * RETURNS TO THE CALLING ROUTINE. IF A DIFFERENT DATA BLOCK 00577000
  587. * OR CHAIN LINK ARE REQUIRED, THE SECTIONS OF CODE 00578000
  588. * FOLLOWING THIS SECTION ARE REQUIRED. 00579000
  589. * 00580000
  590. **************************************************** 00581000
  591. * 00582000
  592. USING FSTSECT,R12 (FOR A WHILE) 00583000
  593. PROCES LTR R4,R4 IS ITEM-NUMBER SUPPLIED IN P-LIST ? 00584000
  594. BP LR34 BP IF YES, USE IT. 00585000
  595. SR R4,R4 EMPTY OUT A REGISTER. V0510 00586000
  596. ICM R4,B'0011',FSTWP GET THE WRITE-POINTER. V0510 00587000
  597. AR R3,R4 TEST FOR TOO MANY ITEMS 00588000
  598. C R3,=F'65535' CHECK AGAINST THE MAXIMUM V0510 00589000
  599. BL LR34 TRF IF OK - NO MORE THAN 65533. 00590000
  600. ERROR6 LA R15,6 ERROR 6 IF MORE ITEMS TO BE IN A FILE 00591000
  601. B ERR THAN CAN FIT INTO A HALFWORD COUNTER ! 00592000
  602. * 00593000
  603. LR34 LR R3,R4 CALCULATE BLOCK 00594000
  604. BCTR 3,0 NO. AND BYTE NO. 00595000
  605. M R2,FSTIL WITHIN BLOCK 00596000
  606. D R2,EIGHTHD BLOCKNO IN 3; BYTENO IN 2. V0510 00597000
  607. L R15,FSTIL GET NO. BYTES TO BE WRITTEN. V0510 00598000
  608. MR R14,R8 MULTIPLY BY THE NUMBER OF ITEMS. V0510 00599000
  609. LR R5,R15 PUT PRODUCT INTO R5. V0510 00600000
  610. DROP R12 00601000
  611. LTR R9,R9 DO WE NEED TO GET AN ACTIVE TABLE ENTRY ? 00602000
  612. BP SETWR BP IF WE'VE ALREADY GOT ONE. 00603000
  613. L R15,AACTFREE IF NOT, CALL ACTFREE 00604000
  614. BALR R14,R15 (R0 & R1 ARE STILL SET FROM FSTLKW) 00605000
  615. LR R9,R1 REFERENCE ACTIVE FILE TABLE VIA R9, 00606000
  616. * 00607000
  617. SETWR L R12,AFTADT REFERENCE ACTIVE DISK TABLE 00608000
  618. ST R12,PLIST+12 STORE IN RDTK/WRTK P-LIST 00609000
  619. STH R4,AFTWP STORE WRITE-POINTER 00610000
  620. NI AFTFLG2,255-SAMELEN INITIALIZE SAME LENGTH @VA09491 00610500
  621. TM AFTFLG,AFTWRT IS IT ALREADY AN ACTIVE-WRITE ? 00611000
  622. BO INSERT BO IF YES, GET ON WITH IT. 00612000
  623. OI AFTFLG,AFTWRT IT'S AN ACTIVE WRITE NOW, CONTINUE... 00613000
  624. LA R0,125 GET 1000 BYTES OF FREE STORAGE. V0510 00614000
  625. DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR, @VA03665X00615000
  626. ERR=ERROR25P @VA03665 00616000
  627. USING ADTSECT,R12 @VA03665 00617000
  628. LH R15,ADTNACW INCREMENT NUMBER OF ACTIVE @VA03665 00618000
  629. AR R15,R7 WRITE FILES BY 1 @VA03665 00619000
  630. STH R15,ADTNACW AND STORE NEW VALUE @VA03665 00620000
  631. SR R14,R14 ZERO FOR DIVIDE @VA04916 00621000
  632. D R14,=F'20' (20 FST'S PER HYPERBLOCK) @VA04916 00622000
  633. LTR R14,R14 ANY REMAINDER? @VA04916 00623000
  634. BP RESOK YES; SKIP @VA04916 00624000
  635. LH R14,ADTRES NO; INCREMENT RESERVE COUNT @VA04916 00625000
  636. LA R14,2(,R14) BY 2 (DISK MAY BE UPDATED TWICE) @VA04916 00626000
  637. STH R14,ADTRES AND RESTORE IT @VA04916 00627000
  638. DROP R12 @VA04916 00628000
  639. RESOK ST R1,AFTFCLA SAVE ADDRESS OF THE FCL BUFFER @VA04916 00629000
  640. LR R6,R1 WE'LL NEED THIS LATER. V0510 00630000
  641. XC 0(200,R1),0(R1) ZERO-OUT THE FCL IN STORAGE. V0510 00631000
  642. LA R1,200(,R1) DATA BUFFER IS 200 BYTES BEYOND. V0510 00632000
  643. ST R1,AFTDBA SAVE ADDR OF DATA-BLOCK BUFFER. V0510 00633000
  644. TM AFTFLG2,AFTNEW IS THIS A NEW FILE? V0510 00634000
  645. BO RESET ALREADY DONE, IF SO. V0510 00635000
  646. SR R7,R7 SIGNAL READING AN FCL. V0510 00636000
  647. LA R8,AFTFCL POINT TO THE DISK ADDR REQUIRED. V0510 00637000
  648. BAL R14,FSRD1 READ IT IN. V0510 00638000
  649. BNZ ERROR3 BETTER TO QUIT IF ERROR. V0510 00639000
  650. RESET MVC AFTCLB(80),0(6) MOVE CL DISK ADDRS TO AFT V0510 00640000
  651. MVC AFTCLN(2),ONEH SIGNAL THIS IS THE FCL. V0510 00641000
  652. MVC AFTCLD(2),AFTFCL SET DISK ADDR OF FCL. V0510 00642000
  653. CLI AFTFV,C'V' IS IT A VARIABLE LENGTH ITEM? V0510 00643000
  654. BE VARINT YES. INITIALIZE THE FILE. V0510 00644000
  655. FINDBLOK BAL R14,DISKRD FIND THE RIGHT DATA BLOCK, @VM03232 00645000
  656. B INSRT AND GO INSERT THE RECORD(S). @VM03232 00646000
  657. INSERT DS 0H NOTE -- R9 NOW ALREADY POINTS TO RIGHT ACTIVE-TABLE 00647000
  658. CLI AFTFV,C'V' IS IT VARIABLE LENGTH ITEM 00648000
  659. BE VARINS YES - INSERT ITEM @VM03232 00649000
  660. TM AFTFLG,AFTDBF IS THERE A DATA BLOCK IN STORAGE?@VM03232 00650000
  661. BZ FINDBLOK IF NOT, GO FIND THE RIGHT BLOCK. @VM03232 00651000
  662. LH R6,AFTDBN YES - GET "DATA BLOCK NUMBER", @VM03232 00652000
  663. CR R6,R3 DOES IT CONTAIN THIS RECORD ? @VM03232 00653000
  664. BE INSRT YES - GO INSERT THE RECORD(S). @VM03232 00654000
  665. WRITEBLK BAL R14,DISKRW NO - WRITE CURRENT BLOCK FIRST @VM03232 00655000
  666. * INSERT GIVEN RECORD(S) IN DATA BLOCK (AND WRITE IT OUT IF FULL): 00656000
  667. * NOTE: R2 = DISPLACEMENT OF RECORD; R5 = NO. OF BYTES TO BE WRITTEN 00657000
  668. INSRT L R8,PADDRX GET ADDR. OF DATA TO BE WRITTEN @VM03232 00658000
  669. LTR R2,R2 START ON A BLOCK BOUNDARY ? @VM03232 00659000
  670. BNZ RESL NOPE - MUST MOVE THE DATA ETC. @VM03232 00660000
  671. C R5,EIGHTHD IF YES, BLOCK COUNT 800 OR MORE? @VM03232 00661000
  672. BNL LARGEBLK YES - WRITE FORTHWITH. @VM03232 00662000
  673. * HANDLE GENERAL CASE OF SMALL AND/OR UNALIGNED LOGICAL RECORD: 00663000
  674. RESL OI AFTFLG,AFTDBF SIGNAL DATA BLOCK IS IN STORAGE @VM03232 00664000
  675. L R0,AFTDBA GET ADDRESS OF DATA BLOCK @VM03232 00665000
  676. AR R0,R2 ADDRESS OF WHERE TO MOVE TO @VM03232 00666000
  677. LR R14,R8 WHERE TO MOVE FROM @VM03232 00667000
  678. LA R6,Q800 CALCULATE SPACE REMAINING @VM03232 00668000
  679. SR R6,R2 IN THE BLOCK @VM03232 00669000
  680. CR R6,R5 WILL THE RECORD FIT IN THE @VM03232 00670000
  681. * BLOCK ? 00671000
  682. BNL PUTEX YES - PUT IT IN THE BLOCK AND @VM03232 00672000
  683. * EXIT. 00673000
  684. * RECORD WILL NOT FIT IN DATA BLOCK: 00674000
  685. LR R1,R6 SET BYTE COUNT TO WHAT WILL FIT @VM03232 00675000
  686. LR R15,R6 ... @VM03232 00676000
  687. MVCL R0,R14 MOVE WHAT WE CAN @VM03232 00677000
  688. AR R8,R6 BUMP ADDRESS BY NO. BYTES WRITTEN@VM03232 00678000
  689. ST R8,PADDRX REMEMBER FOR LATER, @VM03232 00679000
  690. SR R5,R6 SIMILARLY DECREMENT COUNT @VM03232 00680000
  691. SR R2,R2 R2=0 MEANS START AT BEGIN OF BLK @VM03232 00681000
  692. A R3,ONE BUMP DISK "BLOCK" NUMBER @VM03232 00682000
  693. B WRITEBLK GO WRITE OUT FILLED-UP BLOCK. @VM03232 00683000
  694. SPACE 00684000
  695. LARGEBLK EQU * LARGE BLOCK (800 BYTES OR MORE) @VM03232 00685000
  696. * R2 = DISPLACEMENT = 0 00686000
  697. * R3 = "BLOCK NUMBER" (0 UP) 00687000
  698. * R5 = BYTE COUNT = 800 OR MORE 00688000
  699. * R8 = ADDRESS OF DATA TO BE WRITTEN 00689000
  700. NI AFTFLG,FF-AFTDBF SIGNAL "NO DATA BLOCK EXISTS" @VM03232 00690000
  701. ST R2,AFTDBD ALSO CLEAR AFTDBD (AND AFTDBN) @VM03232 00691000
  702. ST R8,PLIST STORE STARTING DATA-ADDRESS @VM03232 00692000
  703. LR R7,R3 GET "BLOCK NUMBER" (0 UP) @VM03232 00693000
  704. SH R7,SIXTY LESS SIXTY @VM03232 00694000
  705. BM LARGEB1 BRANCH IF BLK NO. WAS 0-59 @VM03232 00695000
  706. SR R6,R6 IF 60 OR MORE, DIVIDE @VM03232 00696000
  707. D R6,FOURHD BY 400 TO GET C.L. OFFSET @VM03232 00697000
  708. LA R7,Q798 SET LIMIT FOR END OF CHAIN LINK @VM03232 00698000
  709. L R2,AFTCLA GET ADDRESS OF NTH CHAIN LINK, @VM03232 00699000
  710. B LARGEB2 BRANCH TO COMMON CODE BELOW. @VM03232 00700000
  711. LARGEB1 LR R6,R3 GET BLOCK NUMBER AGAIN (0-59) @VM03232 00701000
  712. LA R7,Q118 SET LIMIT FOR END OF CHAIN LINK @VM03232 00702000
  713. L R2,AFTFCLA GET ADDRESS OF FIRST CHAIN LINK @VM03232 00703000
  714. LA R2,Q80(,R2) PLUS OFFSET TO POINT TO DATA BLKS@VM03232 00704000
  715. LARGEB2 AR R6,R6 DOUBLE THE CHAIN LINK OFFSET @VM03232 00705000
  716. AR R7,R2 COMPUTE ADDRESS OF CHAIN LINK END@VM03232 00706000
  717. AR R2,R6 COMPUTE WHERE WE WILL START @VM03232 00707000
  718. ST R2,PLIST+8 STORE IN WRTK P-LIST @VM03232 00708000
  719. LA R6,2 R6=2 FOR BXLE USE @VM03232 00709000
  720. * "GETBLOCK" LOOP TO OBTAIN DISK BLOCKS ON WHICH TO WRITE THE DATA: 00710000
  721. LARGEB3 A R3,ONE INCREMENT "BLOCK NUMBER" @VM03232 00711000
  722. SR R15,R15 CLEAR R15 PLEASE, @VM03232 00712000
  723. CH R15,0(,R2) CHECK FOR PRE-EXISTING BLOCK @VM03232 00713000
  724. BNE LARGEB4 IF SOMETHING THERE, USE IT @VM03232 00714000
  725. BAL R14,GETBLOCK IF NOT, GET A NEW BLOCK @VM03232 00715000
  726. BNZ LARGEB5 BEWARE OF FULL DISK @VM03232 00716000
  727. STH R1,0(,R2) OK - STORE NEW BLOCK DISK ADDR @VM03232 00717000
  728. LH R14,AFTDBC INCREMENT DATA-BLOCK-COUNT @VM03232 00718000
  729. LA R14,1(,R14) ... @VM03232 00719000
  730. STH R14,AFTDBC ... @VM03232 00720000
  731. LARGEB4 LA R14,Q800 NEED PHYSICAL BLOCK LENGTH, @VM03232 00721000
  732. AR R8,R14 BUMP DATA-BLOCK ADDRESS @VM03232 00722000
  733. SR R5,R14 DECREMENT BYTE COUNT @VM03232 00723000
  734. CR R5,R14 AT LEAST 800 BYTES LEFT ? @VM03232 00724000
  735. BL LARGEB6 IF NOT, GO WRITE. @VM03232 00725000
  736. BXLE R2,R6,LARGEB3 ITERATE "GETBLOCK" LOOP ... @VM03232 00726000
  737. B LARGEB6 NO ROOM LEFT IN CHAIN LINK. @VM03232 00727000
  738. SPACE 00728000
  739. * ERROR FROM DMKTRK (TRKLKP) TRYING TO GET A BLOCK ON DISK: 00729000
  740. LARGEB5 BAL R14,GIVEBACK GIVE BACK BLOCK WE WON'T USE @VM03232 00730000
  741. LA R15,4 REMEMBER ERROR 4 FROM TRKLKP @VM03232 00731000
  742. BCTR R3,0 ALSO DECREMENT R3 BLOCK NUMBER @VM03232 00732000
  743. SPACE 00733000
  744. * NO MORE ROOM IN CHAIN LINK OR WE HAVE ALL THE BLOCKS WE NEED: 00734000
  745. LARGEB6 STH R3,AFTDBN KEEP "AFTDBN" CURRENT @VM03232 00735000
  746. LR R2,R15 REMEMBER TRKLKP RETURN CODE @VM03232 00736000
  747. LR R1,R8 ACCUMULATED ADDRESS INTO R1, @VM03232 00737000
  748. S R1,PLIST COMPUTE ACCUMULATED BYTE-COUNT, @VM03232 00738000
  749. BNP LARGEB7 BEWARE NO BLOCKS WRITTEN AT ALL, @VM03232 00739000
  750. ST R1,PLIST+4 OK - STORE IN WRTK PLIST @VM03232 00740000
  751. LA R1,PLIST POINT TO WRTK P-LIST, @VM03232 00741000
  752. L R15,AWRTK GET ADDRESS OF WRTK @VM03232 00742000
  753. BALR R14,R15 WRITE OUT THE BLOCK(S) @VM03232 00743000
  754. BNZ ERROR3 VERY DISAPPOINTING IF WRTK ERROR @VM03232 00744000
  755. * NOW CHECK TO SEE IF WE HAVE ANY MORE TO DO ... 00745000
  756. LARGEB7 LTR R2,R2 CHECK TRKLKP RETURN CODE @VM03232 00746000
  757. BNZ WRCHECK IF NOT 0, USE DISK-IS-FULL LOGIC @VM03232 00747000
  758. * CONTINUE IF R2 (BYTE DISPLACEMENT) = 0: 00748000
  759. LTR R0,R5 CHECK REMAINING BYTE COUNT R5/R0 @VM03232 00749000
  760. BZ UPDPT IF NOTHING LEFT, GO FINISH UP. @VM03232 00750000
  761. ST R8,PADDRX PRESERVE R8 (DATA ADDRESS) @VM03232 00751000
  762. B FINDBLOK GO CALL DISKRD & GO TO INSRT. @VM03232 00752000
  763. SPACE 00753000
  764. * RECORD WILL FIT IN DATA BLOCK: 00754000
  765. PUTEX LR R1,R5 BYTE COUNT @VM03232 00755000
  766. LR R15,R5 ... @VM03232 00756000
  767. MVCL R0,R14 MOVE RECORD TO FREE STORAGE BLK @VM03232 00757000
  768. * NOTE: R0 POINTS TO END OF RECORD 00758000
  769. S R0,AFTDBA MAKE RELATIVE TO DATA BLOCK @VM03232 00759000
  770. UPDPT EQU * FINISH UP AND GET OUT OF HERE: @VM03232 00760000
  771. STH R0,AFTID AND STORE ITEM DISPLACEMENT @VM03232 00761000
  772. SR R6,R6 TIP OVER A REGISTER. V0510 00762000
  773. ICM R6,B'0011',AFTWP GET THE WRITE-POINTER. V0510 00763000
  774. AH 6,PNOIT(0,11) UPDATE WRITE POINTER 00764000
  775. STH R6,AFTWP 00765000
  776. STH 6,AFTIN STORE ITEM NUMBER 00766000
  777. BCTR 6,0 NO. OF ITEMS = WRITE POINTER - 1 00767000
  778. CLM R6,M3,AFTIC IS WRITE-PTR > NO. OF ITEMS? @VA07151 00768000
  779. BNH CLIV BNH IF NOT. 00769000
  780. STH R6,AFTIC YES, SET NEW NO. ITEMS COUNT 00770000
  781. CLIV CLI AFTFV,C'V' IS IT VARIABLE LENGTH ? 00771000
  782. BNE LMREG NO, NO NEED TO UPDATE LENGTH 00772000
  783. L R15,PNOBY(,R11) GET LENGTH OF THIS RECORD @VM03232 00773000
  784. CL R15,AFTIL IS THIS RECORD THE LONGEST YET ? @VM03232 00774000
  785. BNH LMREG NO - GO RESTORE REGISTERS @VM03232 00775000
  786. ST R15,AFTIL STORE NEW LONGEST ITEM LENGTH @VM03232 00776000
  787. LMREG SR R15,R15 CLEAR REGISTER 15 FOR SUCCESSFUL RETURN 00777000
  788. * 00778000
  789. ERR KXCHK WRBIT CHECK FOR 'KX' WANTED... 00779000
  790. LTR R13,R13 HAS CHAIN LINK BEEN WRITTEN ? 00780000
  791. BM WRBEX3 TRF IF YES - HANDLE SPECIALLY. 00781000
  792. WRBEX1 LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00782000
  793. WRBEX2 LM R0,R14,REGSAV3 RESTORE REGISTERS R0-R14 00783000
  794. BR R14 AND RETURN TO CALLER. 00784000
  795. SPACE 1 00785000
  796. WRBEX3 LR R3,R15 REMEMBER THE RETURN-CODE IN R3; @VA01100 00786000
  797. L R2,AFTADT NEED ADDR OF ADT FOR THIS DISK @VA01100 00787000
  798. MOVEREGS MVC REGSAV4(60),REGSAV3 AVOID REGSAVING PROBLEMS. V0510 00788000
  799. LR R0,R2 POINT TO THE ADT. V0510 00789000
  800. SR R1,R1 SIGNAL JUST TFINIS. V0510 00790000
  801. L R15,ATFINIS GET THE ADDR OF TFINIS. V0510 00791000
  802. BALR R14,R15 GO THERE. V0510 00792000
  803. SR R1,R1 SIGNAL WE WANT TO RESERVE BLOCKS. V0510 00793000
  804. L R15,AUPDISK GET THE ADDR OF UPDISK. V0510 00794000
  805. BALR R14,R15 GO THERE. V0510 00795000
  806. MVC REGSAV3(60),REGSAV4 REAVOID REGSAVING PROBLEMS V0510 00796000
  807. LR R1,R2 R1 MUST POINT TO THE ADT @VA01100 00797000
  808. SR R0,R0 GET REASSIGNED NTH CHAIN LINK @VA01100 00798000
  809. ICM R0,B'0011',AFTCLDX ... (IS THERE ONE?) @VA01100 00799000
  810. BZ NOCLDX APPARENTLY NOT. V0510 00800000
  811. * (R1 STILL POINTS TO THE ADT) 00801000
  812. L R15,ATRKLKPX GET THE ADDR OF TRKLKPX. V0510 00802000
  813. BALR R14,R15 GIVE BACK THE OLD N'TH CL. V0510 00803000
  814. ICM R0,B'0011',AFTOCLDX GET "OLD" AFTCLDX @VA01100 00804000
  815. BZ NOCLDX (IF ANY) @VA01100 00805000
  816. * (R1 STILL POINTS TO THE ADT) 00806000
  817. L R15,ATRKLKPX GET ADDR OF TRKLKPX AGAIN @VA01100 00807000
  818. BALR R14,R15 AND "DO IT AGAIN, SAM". @VA01100 00808000
  819. NOCLDX ICM R0,B'0011',AFTFCLX GET OLD FCL DISK ADDR IF ANY @VA01100 00809000
  820. BZ NOFCLX IF NOT, DON'T TRY TO GIVE BACK @VA01100 00810000
  821. * (R1 STILL POINTS TO THE ADT) 00811000
  822. L R15,AQQTRKX GET THE ADDR OF QQTRKX. V0510 00812000
  823. BALR R14,R15 GIVE BACK THE OLD FCL. V0510 00813000
  824. NOFCLX SR R15,R15 FINALLY, CLEAR ... @VA01100 00814000
  825. ST R15,AFTFCLX AFTFCLX AND AFTCLDX @VA01100 00815000
  826. STH R15,AFTOCLDX AND "OLD AFTCLDX" @VA01100 00816000
  827. NI AFTFLG2,255-(AFTCLX+AFTOLDCL) CLEAR FLAG BITS @VA01100 00817000
  828. LR R0,R2 POINT TO THE ADT AGAIN. V0510 00818000
  829. LNR R1,R0 MAKE THE REGISTER NEGATIVE. V0510 00819000
  830. L R15,AUPDISK GET THE ADDR OF UPDISK AGAIN. V0510 00820000
  831. BALR R14,R15 REALLY UPDATE THE DISK NOW. V0510 00821000
  832. CLC AFTCLN(2),ONEH IS THIS A FIRST CHAIN LINK? V0510 00822000
  833. BE ALLDONE NO TROUBLE IF SO. V0510 00823000
  834. OI AFTFLG2,AFTOLDCL SET "AFTOLDCL" FLAGBIT AGAIN @VA01100 00824000
  835. ALLDONE LTR R15,R3 RESTORE RETURN-CODE AND SET C.C. @VA01100 00825000
  836. B WRBEX2 GO TO THE COMMON EXIT. V0510 00826000
  837. EJECT 00827000
  838. ********************************************************************** 00828000
  839. * 00829000
  840. * VARIABLE LENGTH ITEM ROUTINE 00830000
  841. * FILE JUST OPENED. 00831000
  842. * 00832000
  843. ********************************************************************** 00833000
  844. * 00834000
  845. VARINT SR R4,R4 ZERO OUT A REGISTER. V0510 00835000
  846. ICM R4,B'0011',AFTIC GET THE NUMBER OF ITEMS. V0510 00836000
  847. CLM R4,B'0011',AFTWP REPLACING LAST RECORD ? @VA09491 00836040
  848. BE LASTREC YES, OK @VA09491 00836080
  849. BL MAYADD CHECK FOR ADDING NEXT RECORD @VA09491 00836120
  850. TM AFTFLG2,AFTNEW CHECK NEW FILE @VA09491 00836160
  851. BO LASTREC YES, ALLOW DIFFERENT LENGTH @VA09491 00836200
  852. TM DOSFLAGS,DOSMODE IN DOS MOD ? @VA09491 00836240
  853. BO LASTREC YES, SKIP LENGTH CHECK @VA09491 00836280
  854. OI AFTFLG2,SAMELEN CHECK SAME LENGTH @VA09491 00836320
  855. LH R6,FCBNUM COUNT OF FCB ENTRIES @VA09491 00836360
  856. LTR R6,R6 ARE THERE ANY ? @VA09491 00836400
  857. BZ LASTREC NO , SKIP THE CHECK @VA09491 00836440
  858. LA R3,0(,R11) POINT TO WRBUF PLIST @VA09491 00836480
  859. S R3,SIXTEEN BACK UP 4 WORDS @VA09491 00836520
  860. L R7,FCBFIRST FCB ANCHOR @VA09491 00836560
  861. USING FCBSECT,R7 FCB ADDRESSABILITY @VA09491 00836600
  862. LOOPFCB EQU * @VA09491 00836640
  863. CLC FCBDD,EIGHT(R3) FCB DDNAME IN PLIST @VA09491 00836680
  864. BE FOUNDFCB YES, CHECK IT @VA09491 00836720
  865. L R7,0(,R7) BUMP TO NEXT FCB @VA09491 00836760
  866. BCT R6,LOOPFCB LOOP THRU ENTRIES @VA09491 00836800
  867. B LASTREC NOT FOUND @VA09491 00836840
  868. FOUNDFCB EQU * CHECK RECORD FORMAT @VA09491 00836880
  869. NI AFTFLG2,255-SAMELEN NO LENGTH CHECK @VA09491 00836920
  870. LA R7,0(,R7) CLEAR HIGH BYTE @VA09491 00836960
  871. CR R7,R3 THE SAME FCB ? @VA09491 00837000
  872. BNE LASTREC NO, FORGET IT @VA09491 00837040
  873. ICM R3,M7,DEBDCBAD+1 DCB POINTER IN FCB @VA09491 00837080
  874. BZ LASTREC NO , SKIP DCB CHECK @VA09491 00837120
  875. C R3,VMSIZE BEYOND ADDRESSABILITY @VA09491 00837160
  876. BNL LASTREC YES , SKIP IT @VA09491 00837200
  877. USING IHADCB,R3 DCB ADDRESSABILITY @VA09491 00837240
  878. TM DCBRECFM,UND RECFM = UNDEFINED @VA09491 00837280
  879. BO LASTREC YES , SKIP LENGTH CHECK @VA09491 00837320
  880. OI AFTFLG2,SAMELEN ALL REPLACES MUST BE @VA09491 00837360
  881. * THE SAME LENGTH AS BEFORE @VA09491 00837400
  882. B LASTREC BYPASS NEXT CHECK @VA09491 00837440
  883. DROP R3 DROP DCB ADDRESSABILITY @VA09491 00837480
  884. DROP R7 DROP FCB ADDRESSABILITY @VA09491 00837520
  885. MAYADD DS 0H @VA09491 00837560
  886. LA R4,1(,R4) CHECK FOR ADDING ONE RECORD @VA09491 00837600
  887. SR R15,R15 EMPTY ANOTHER REGISTER. V0510 00838000
  888. ICM R15,B'0011',AFTWP AND GET THE WRITE-POINTER. V0510 00839000
  889. CR R4,R15 WRITE PTR. MUST NOT EXCEED NO. OF ITEMS 00840000
  890. BL ERROR7 ERROR 7 IF TROUBLE 00841000
  891. LASTREC DS 0H @VA09491 00841500
  892. SR 3,3 SET TO READ BLOCK NO. 0 00842000
  893. MVC AFTIN(2),ONEH SET THE ITEM NO. TO 1. V0510 00843000
  894. STH R3,AFTID SET DISPLACEMENT = 0 00844000
  895. BAL R14,DISKRD READ APPROPRIATE DATA BLOCK @VM03232 00845000
  896. VARLP1 CLC AFTIN(2),AFTWP ARE WE AT WRITE PLACE 00846000
  897. BE ALLSET YUP, ALMOST FINISHED 00847000
  898. LH 2,AFTID GET DISPLACEMENT WITHIN DATA BLOCK 00848000
  899. C 2,F798 IS ITEM LENGTH IN BLOCK 00849000
  900. BH OVERLP NO, IT PROTRUDES 00850000
  901. BE OVERL3 ONLY LENGTH IN BLOCK 00851000
  902. LR 5,2 GET LOC. OF ITEM LENGTH 00852000
  903. A 5,AFTDBA ... 00853000
  904. SR R15,R15 CLEAR REG, @VM03232 00854000
  905. ICM R15,B'0011',0(R5) MOVE TO NEXT ITEM @VM03232 00855000
  906. LA 2,2(2,15) (ADJUST FOR 2-BYTE ITEM LENGTH) 00856000
  907. VARLP2 EQU * ... 00857000
  908. C R2,EIGHTHD IS ITEM IN THIS BLOCK? V0510 00858000
  909. BL INBLCK YES, SET ITEM NO. AND DISPLACEMENT 00859000
  910. S R2,EIGHTHD SAVE THE COUNT. V0510 00860000
  911. ST 2,SAVECT ... 00861000
  912. LA 3,1(,3) GET NEXT BLOCK 00862000
  913. BAL R14,DISKRD ... @VM03232 00863000
  914. L 2,SAVECT RESTORE COUNT 00864000
  915. B VARLP2 TEST FOR ITEM 00865000
  916. INBLCK STH 2,AFTID STORE DISPLACEMENT 00866000
  917. SR R2,R2 EMPTY A REGISTER V0510 00867000
  918. ICM R2,B'0011',AFTIN GET ITEM-NUMBER FOR INCREMENTINV0510 00868000
  919. LA 2,1(,2) ... 00869000
  920. STH 2,AFTIN ... 00870000
  921. B VARLP1 TEST ITEM NUMBER 00871000
  922. SPACE 1 00872000
  923. OVERLP C R2,EIGHTHD IS IT IN THE NEXT BLOCK? V0510 00873000
  924. BE OVERL2 YES, READ IT IN 00874000
  925. LR 5,2 GET LOC. OF FIRST BYTE 00875000
  926. A 5,AFTDBA ... 00876000
  927. MVC ALIGN(1),0(5) MOVE FIRST BYTE 00877000
  928. LA 3,1(,3) READ NEXT BLOCK 00878000
  929. BAL R14,DISKRD ... @VM03232 00879000
  930. L 5,AFTDBA GET LOC. OF SECOND BYTE 00880000
  931. MVC ALIGN+1(1),0(5) ... 00881000
  932. L R2,FALIGN GET ITEM LENGTH 00882000
  933. LA 2,1(,2) (ADJUST FOR 1-BYTE LENGTH) 00883000
  934. B VARLP2 CONTINUE ON 00884000
  935. OVERL2 LA 3,1(,3) READ NEXT BLOCK 00885000
  936. BAL R14,DISKRD ... @VM03232 00886000
  937. L 5,AFTDBA GET ITEM LENGTH 00887000
  938. SR R2,R2 MAKE A WORK REGISTER. V0510 00888000
  939. ICM R2,B'0011',0(R5) V0510 00889000
  940. LA 2,2(,2) (ADJUST FOR 2-BYTE LENGTH) 00890000
  941. B VARLP2 CONTINUE ON 00891000
  942. OVERL3 LR 5,2 GET LOC. OF ITEM LENGTH 00892000
  943. A 5,AFTDBA ... 00893000
  944. MVC ALIGN(2),0(5) SAVE ITEM LENGTH 00894000
  945. LA 3,1(0,3) GET NEXT BLOCK 00895000
  946. BAL R14,DISKRD ... @VM03232 00896000
  947. L R2,FALIGN SET ITEM LENGTH 00897000
  948. B VARLP2 CONTINUE 00898000
  949. SPACE 3 00899000
  950. ********************************************************************** 00900000
  951. * 00901000
  952. * VARIABLE LENGTH ITEM ROUTINE 00902000
  953. * FILE WAS ALREADY OPEN. 00903000
  954. * 00904000
  955. ********************************************************************** 00905000
  956. VARINS LH R3,AFTDBN BE SURE TO SET BLOCK NO. CORRECTLY P3060 00906000
  957. CLC AFTIN(2),AFTWP ARE WE AT THE WRITE PLACE? P3060 00907000
  958. BE ALLSET YES, THAT WAS EASY 00908000
  959. L R6,AFTDBA POINT TO THE DATA BLOCK BUFFER. V0510 00909000
  960. LA R8,AFTDBD POINT TO THE DISK ADDR OF THE DATA V0510 00910000
  961. BAL R14,CONFSWR WRITE OUT THE DATA BLK (IF ANY) @VM03232 00911000
  962. BZ VARINT IF R15 = 0, SEARCH FOR CORRECT PLACE 00912000
  963. ERROR3 L R14,ADISKDIE STOP NOW TO PRESERVE @VA00895 00913000
  964. BR R14 OLD DIRECTORY @VA00895 00914000
  965. EJECT 00915000
  966. ********************************************************************** 00916000
  967. * 00917000
  968. * VARIABLE LENGTH ITEM ROUTINE 00918000
  969. * SET VARIABLE LENGTH ITEM LENGTH, AND INSERT DATA 00919000
  970. * 00920000
  971. ********************************************************************** 00921000
  972. ALLSET LH 2,AFTID GET DISPLACEMENT 00922000
  973. C 2,F798 IS EVERYTHING IN THIS BLOCK 00923000
  974. BH ALS2 NO, ADJUST THINGS 00924000
  975. BE ALS5 ONLY LENGTH IN THIS BLOCK 00925000
  976. ALS4 LTR R5,R2 GET DISPLACEMENT FOR ITEM LENGTH @VM03232 00926000
  977. BNZ ALS4A BEWARE OF 0 (OK IF NOT). @VM03232 00927000
  978. CH R5,AFTDBD IS DATA BLOCK NONEXISTENT ? @VM03232 00928000
  979. BNE ALS4A NOPE (WHEW) - WE'RE OK. @VM03232 00929000
  980. BAL R14,DISKRD YES - INITIALIZE DATA BLOCK @VM03232 00930000
  981. ALS4A A R5,AFTDBA FORM ADDRESS FOR ITEM LENGTH @VM03232 00931000
  982. TM AFTFLG2,SAMELEN MUST CHECK LENGTH ? @VA09491 00931100
  983. BZ LAB1 NO,CONTINUE @VA09491 00931200
  984. CLC 0(2,R5),PNOBY+2(R11) IS LENGTH OK @VA09491 00931300
  985. BNE ERROR27 NO , WRONG LENGTH @VA09491 00931400
  986. LAB1 DS 0H @VA09491 00931500
  987. MVC 0(2,5),PNOBY+2(11) INSERT ITEM LENGTH 00932000
  988. LA 2,2(,2) ADJUST DISPLACEMENT 00933000
  989. L 5,PNOBY(,11) SET NUMBER OF BYTES TO WRITE 00934000
  990. B INSRT INSERT DATA INTO BLOCK 00935000
  991. ALS2 C R2,EIGHTHD IS IT IN THIS BLOCK? V0510 00936000
  992. BE ALS3 NO, GET NEXT ONE 00937000
  993. LR 5,2 GET LOC. TO PUT FIRST BYTE 00938000
  994. A 5,AFTDBA ... 00939000
  995. TM AFTFLG2,SAMELEN MUST CHECK LENGTH ? @VA09491 00939100
  996. BZ LAB2 NO, CONTINUE @VA09491 00939200
  997. CLC 0(1,R5),PNOBY+2(R11) IS FIRST HALF OK ? @VA09491 00939300
  998. BNE ERROR27 NOPE @VA09491 00939400
  999. LAB2 DS 0H @VA09491 00939500
  1000. MVC 0(1,5),PNOBY+2(11) INSERT FIRST BYTE TO ITEM LENGTH 00940000
  1001. LA 3,1(,3) GET NEXT BLOCK 00941000
  1002. BAL R14,DISKRW ... @VM03232 00942000
  1003. L 5,AFTDBA GET LOC. TO PUT SECOND BYTE 00943000
  1004. TM AFTFLG2,SAMELEN MUST CHECK LENGTH @VA09491 00943100
  1005. BZ LAB3 NO, CONTINUE @VA09491 00943200
  1006. CLC 0(1,R5),PNOBY+3(R11) IS SECOND HALF OK ? @VA09491 00943300
  1007. BNE ERROR27 NO, DIFFERENT LENGTH @VA09491 00943400
  1008. LAB3 DS 0H @VA09491 00943500
  1009. MVC 0(1,5),PNOBY+3(11) INSERT SECOND BYTE 00944000
  1010. LA 2,1 SET DISPLACEMENT=1 00945000
  1011. L 5,PNOBY(,11) SET NUMBER OF BYTES TO WRITE 00946000
  1012. B INSRT INSERT DATA INTO BLOCK 00947000
  1013. ALS3 LA 3,1(,3) GET NEXT BLOXK 00948000
  1014. BAL R14,DISKRW ... @VM03232 00949000
  1015. SR 2,2 SET DISPLACEMENT=0 00950000
  1016. B ALS4 SET ITEM LENGTH 00951000
  1017. ALS5 LR 5,2 GET LOC. TO PUT ITEM LENGTH 00952000
  1018. A 5,AFTDBA ... 00953000
  1019. TM AFTFLG2,SAMELEN MUST CHECK LENGTH @VA09491 00953100
  1020. BZ LAB4 NO, CONTINUE @VA09491 00953200
  1021. CLC 0(2,R5),PNOBY+2(R11) IS LENGTH OK @VA09491 00953300
  1022. BNE ERROR27 NO, DIFFERENT LENGTH @VA09491 00953400
  1023. LAB4 DS 0H @VA09491 00953500
  1024. MVC 0(2,5),PNOBY+2(11) INSERT ITEM LENGTH 00954000
  1025. LA 3,1(0,3) GET NEXT BLOCK 00955000
  1026. BAL R14,DISKRW ... @VM03232 00956000
  1027. SR 2,2 SET DISPLACEMENT 00957000
  1028. L 5,PNOBY(0,11) AND NO. OF BYTES 00958000
  1029. B INSRT INSERT DATA 00959000
  1030. ERROR27 EQU * @VA09491 00959200
  1031. LA R15,27 ERROR CODE 26 @VA09491 00959400
  1032. B ERR RETURN WITH AN ERROR @VA09491 00959600
  1033. EJECT 00960000
  1034. ********************************************************************** 00961000
  1035. * 00962000
  1036. * DISK INTERFACE ROUTINE FOR FIXED OR VARIABLE LENGTH ITEM(S) 00963000
  1037. * 00964000
  1038. * PARAMETERS- 00965000
  1039. * 00966000
  1040. * REG. 3 - DESIRED DATA BLOCK NO. 00967000
  1041. * REG. 14 - RETURN ADDRESS 00968000
  1042. * 00969000
  1043. ********************************************************************** 00970000
  1044. * 00971000
  1045. * DISKRD - READ DESIRED BLOCK 00972000
  1046. DISKRD ST R14,DSKRET SAVE RETURN ADDRESS @VM03232 00973000
  1047. B SWICH2 GO TO IT @VM03232 00974000
  1048. * 00975000
  1049. * DISKRW - WRITE CURRENT BLOCK BEFORE READ 00976000
  1050. DISKRW ST R14,DSKRET SAVE RETURN ADDRESS @VM03232 00977000
  1051. * 00978000
  1052. * CONTINUE 'IN LINE' TO 'SWICH' ... 00979000
  1053. SPACE 00980000
  1054. ******************************************************** 00981000
  1055. * 00982000
  1056. * THE CURRENT DATA BLOCK IS WRITTEN ON THE DISK. IF A 00983000
  1057. * DIFFERENT CHAIN LINK IS REQUIRED TO DEFINE THE NEW DATA 00984000
  1058. * BLOCK, THE OLD CHAIN LINK IS WRITTEN ONTO THE DISK AND 00985000
  1059. * THE NEXT CHAIN LINK IS OBTAINED FROM THE DISK IF IT HAD 00986000
  1060. * BEEN PREVIOUSLY DEFINED. IF A NEW CHAIN 00987000
  1061. * LINK MUST BE DEFINED, ITS ADDRESS IS PLACED IN THE FIRST 00988000
  1062. * CHAIN LINK. THE NEXT DATA BLOCK THEN IS READ FROM 00989000
  1063. * THE DISK IF IT PREVIOUSLY EXISTED, OR IF IT DID NOT EXIST, 00990000
  1064. * IT IS NOW DEFINED BY PLACING ITS NEW DISK ADDRESS IN THE 00991000
  1065. * CHAIN LINK. THE PROGRAM RETURNS TO THE PRIVIOUS SECTION 00992000
  1066. * OF CODE FOR INSERTION OF THE DATA ITEM INTO THE DATA BLOCK 00993000
  1067. * WHICH WAS JUST SET UP IN CORE. 00994000
  1068. * 00995000
  1069. ********************************************** 00996000
  1070. SWICH L R6,AFTDBA POINT TO THE DATA BLOCK BUFFER. V0510 00997000
  1071. LA R8,AFTDBD INDICATE THE DISK ADDR. V0510 00998000
  1072. BAL R14,CONFSWR WRITE OUT THE DATA BLK (IF ANY) @VM03232 00999000
  1073. BNZ ERROR3 BNZ IF PERMANENT I/O ERROR ON DISK. 01000000
  1074. SWICH2 LH 8,AFTCLN IS THIS THE RIGHT 01001000
  1075. C 8,ONE CHAIN LINK 01002000
  1076. BE RCL YES - BRANCH. @VM03232 01003000
  1077. SH R8,TWOH NO - CALCULATE @VM03232 01004000
  1078. L 7,FOURHD (X-2)*400+60 01005000
  1079. MR 6,8 01006000
  1080. AH 7,SIXTY LOWER LIMIT TEST 01007000
  1081. CR 7,3 01008000
  1082. BH LINKSW WRONG CHAIN LINK 01009000
  1083. A 7,THRNN 01010000
  1084. CR 7,3 UPPER LIMIT TEST 01011000
  1085. BNL NLKPTR RIGHT BLOCK NO. 01012000
  1086. LINKSW L R6,AFTCLA POINT TO THE CHAIN LINK BUFFER V0510 01013000
  1087. LA R8,AFTCLD POINT TO THE ADDR ON DISK V0510 01014000
  1088. BAL R14,FSWR WRITE OUT THE CHAIN LINK. V0510 01015000
  1089. BNZ ERROR3 QUIT IF UNEXPECTED ERROR. V0510 01016000
  1090. TM AFTFLG2,AFTCLX HAS ANY MODIFICATION TAKEN PLACE? V0510 01017000
  1091. BNO RELINK PROCEED WITH ABANDON,IF NOT. V0510 01018000
  1092. O R13,SIGNBIT R13 'MINUS' MEANS C.L. HAS BEEN WRITTEN 01019000
  1093. RELINK CH 3,FIFNI IS BLOCK NO. BETWEEN 01020000
  1094. BH MORTST ZERO AND 59 01021000
  1095. MVC AFTCLN(2),ONEH SET CHAIN-LINK-NUMBER TO 1 01022000
  1096. MVC AFTCLD(2),AFTFCL DISK ADDR OF FCL. V0510 01023000
  1097. CLNUP NI AFTFLG2,255-AFTOLDCL ALL ELSE CORRECT. V0510 01024000
  1098. LR R4,R3 MAKE A COPY OF THE BLOCK NUMBER. V0510 01025000
  1099. AR R4,R4 DOUBLE IT, FOR INDEXING. V0510 01026000
  1100. LA R4,80(,R4) SHOW OFFSET INTO FCL FOR DATA BLOCK V0510 01027000
  1101. L R8,AFTFCLA POINT TO FCL BUFFER. V0510 01028000
  1102. B FCLNUP PRETEND THAT WE JUST READ IT IN. V0510 01029000
  1103. * 01030000
  1104. RCL CH R3,FIFNI IS BLOCK NO. BETWEEN 0 AND 59 ? @VM03232 01031000
  1105. BNH CLNUP BRANCH IF YES @VM03232 01032000
  1106. TM AFTFLG2,AFTCLX HAS ANY MODIFICATION TAKEN PLACE?@VM03232 01033000
  1107. BNO MORTST NO WORRY, IF NOT. @VM03232 01034000
  1108. O R13,SIGNBIT PRETEND A CHAIN LINK WAS WRITTEN @VM03232 01035000
  1109. * AND CONTINUE TO "MORTST" ... 01036000
  1110. MORTST SR 6,6 CALCULATE (N-60)/400+2 01037000
  1111. LR 7,3 =X=NO. C.L. TO BE 01038000
  1112. SH 7,SIXTY PLACED IN CORE 01039000
  1113. D 6,FOURHD 01040000
  1114. LA 7,2(0,7) 01041000
  1115. CH R7,MAXCHAIN ARE BEYOND CHAIN-LINK 41 ? 01042000
  1116. BH ERROR19 ERROR 19 IF YES - DON'T LET HIM DO IT. 01043000
  1117. STH 7,AFTCLN 01044000
  1118. TM AFTFLG,AFTFBA IS BUFFER FOR N'TH 01045000
  1119. BO CLODT CHAIN LINK ASSIGNED, YES 01046000
  1120. LA R0,100 GET N'TH CHAIN-LINK BUFFER. V0510 01047000
  1121. DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR V0510 01048000
  1122. LTR R15,R15 MUST ACQUIRE FREE STORAGE @VA02374 01049000
  1123. BNZ ERROR25 OR FAIL @VA02374 01050000
  1124. ST 1,AFTCLA 01051000
  1125. OI AFTFLG,AFTFBA SET N'TH BUF. ASSIGN. BIT 01052000
  1126. CLODT LH 8,AFTCLN DOES CHAIN LINK 01053000
  1127. AR R8,R8 SOUGHT EXIST ON 01054000
  1128. SH 8,FOUR DISK-CALCULATE X*2-4 01055000
  1129. LH R6,AFTCLB(R8) 01056000
  1130. LTR 6,6 01057000
  1131. BZ ASQRK NO 01058000
  1132. STH 6,AFTCLD STORE DISK ADDR. OF CHAIN LINK 01059000
  1133. L R6,AFTCLA POINT TO THE CHAIN LINK BUFFER. V0510 01060000
  1134. LA R8,AFTCLB(R8) POINT TO OFFSET OF CHAIN LINK ADDR V0510 01061000
  1135. BAL R14,FSRD READ IN THE CHAIN LINK. V0510 01062000
  1136. BNZ ERROR3 QUIT ON ERROR CONDITION. V0510 01063000
  1137. OI AFTFLG2,AFTOLDCL SIGNAL NCL EXISTED PREVIOUSLY. V0510 01064000
  1138. B NLKPTR NOW LOCATE THE DATA BLOCK. V0510 01065000
  1139. ASQRK BAL R14,GETBLOCK GET A CHAIN LINK ALLOCATED. V0510 01066000
  1140. BNZ BADNEWS IF ERROR FROM TRKLKP GETTING A CHAIN-LINK 01067000
  1141. STH 1,AFTCLD DISK ADDR. OF CHAIN LINK IN CORE 01068000
  1142. STH R1,AFTCLB(R8) INSERT C.L. ADDR. IN F.C.L. 01069000
  1143. L 14,AFTCLA CLEAR N'TH CHAIN 01070000
  1144. L R15,EIGHTHD SIZE INTO R15 @VA01100 01071000
  1145. SR R1,R1 CLEAR R1 (R0 IS IMMATERIAL) @VA01100 01072000
  1146. MVCL R14,R0 CLEAR THE N'TH CHAIN LINK @VA01100 01073000
  1147. NLKPTR LR 7,3 FIND POINTER TO ADDRESS 01074000
  1148. SH 7,SIXTY OF DATA BLOCK IN 01075000
  1149. SR R6,R6 CHAIN LINK 01076000
  1150. D 6,FOURHD EQUAL REMAINDER OF (X-60)/400=R 01077000
  1151. AR 6,6 R*2=POINTER 01078000
  1152. LR 4,6 01079000
  1153. L R8,AFTCLA POINT TO THE CHAIN LINK BUFFER. V0510 01080000
  1154. FCLNUP SR R6,R6 CREATE POINTER COMPARATOR. V0510 01081000
  1155. AR R4,R8 RESOLVE OFFSET OF DATA ADDR. V0510 01082000
  1156. CH R6,0(,R4) IS ANYTHING THERE? V0510 01083000
  1157. BE QTRK GET ONE, IF NOT. V0510 01084000
  1158. L R6,AFTDBA POINT TO THE DATA BUFFER. V0510 01085000
  1159. LR R8,R4 POINT TO THE DISK ADDR. V0510 01086000
  1160. BAL R14,FSRD READ IN THE BLOCK. V0510 01087000
  1161. BNZ ERROR3 BNZ IF PERMANENT I/O ERROR ON DISK. 01088000
  1162. MVC AFTDBD(2),0(4) INSERT DISK ADDR. OF DATA 01089000
  1163. STH 3,AFTDBN PUT CURRENT BLOCK NO. IN TABLE 01090000
  1164. B DISKRRT RETURN TO INSERT NEW ITEM 01091000
  1165. * BLOCK CURRENTLY IN CORE 01092000
  1166. QTRK CLC AFTDBC(2),MAXBLKS MAX. NO. OF DATA BLOCKS BEEN REACHED 01093000
  1167. BNL ERROR19 ERROR 19 IF YES - QUIT NOW. 01094000
  1168. BAL R14,GETBLOCK ASSIGN A BLOCK. V0510 01095000
  1169. BNZ NEWCHECK BNZ IF ERROR-CODE FROM TRKLKP NOT = 0. 01096000
  1170. LH R14,AFTDBC INCREMENT NO. OF QUARTER DATA TRACKS 01097000
  1171. LA 14,1(,14) 01098000
  1172. STH R14,AFTDBC REPLACE IN F.S.T. TABLE 01099000
  1173. STH 1,AFTDBD D.A. OF DATA BLOCK IN CORE 01100000
  1174. STH 1,0(0,4) DISK ADDR. TO CHAIN LINK 01101000
  1175. STH R3,AFTDBN PUT CURRENT BLOCK NO. IN TABLE 01102000
  1176. L 14,AFTDBA CLEAR DATA BLOCK 01103000
  1177. L R15,EIGHTHD SIZE INTO R15 @VA01100 01104000
  1178. SR R1,R1 CLEAR R1 (R0 IS IMMATERIAL) @VA01100 01105000
  1179. MVCL R14,R0 CLEAR THE DATA BLOCK @VA01100 01106000
  1180. TM AFTFLG2,AFTNEW IS THIS A NEW FILE? V0510 01107000
  1181. BO NOSWAP NO WORRIES, IF SO. V0510 01108000
  1182. TM AFTFLG2,AFTOLDCL MODIFYING SOMETHING PERCHANCE? V0510 01109000
  1183. BNO FLAGMOD IF NOT, SIGNAL IT MILDLY ANYWAY. V0510 01110000
  1184. BAL R14,GETBLOCK GET AN ALTERNATE NTH CHAIN LINK @VA01100 01111000
  1185. BNZ PORCPINE IF N.G., HANDLE "VERY CAREFULLY" @VA01100 01112000
  1186. LH R8,AFTCLN GET THE CHAIN LINK NUMBER. V0510 01113000
  1187. AR R8,R8 DOUBLED, FOR HALF-WORD LOGIC. V0510 01114000
  1188. SH R8,FOUR AND OFFSET A LITTLE. V0510 01115000
  1189. MVC AFTOCLDX(2),AFTCLDX SAVE "OLD AFTCLDX" (IF ANY) @VA01100 01116000
  1190. LH R15,AFTCLB(R8) NOW , GET THE OLD DISK ADDR. V0510 01117000
  1191. STH R15,AFTCLDX SAVE IT FOR LATER. V0510 01118000
  1192. STH R1,AFTCLB(R8) INSTALL THE ALTERNATE ADDR. V0510 01119000
  1193. STH R1,AFTCLD ALL OVER THE PLACE. V0510 01120000
  1194. FLAGMOD OI AFTFLG2,AFTCLX SAY SOMETHING HAS BEEN CHANGED. V0510 01121000
  1195. * ASSIGN AN ALTERNATE FIRST CHAIN LINK (UNLESS WE ALREADY HAVE ONE): 01122000
  1196. L R15,AFTADT @VM03203 01123000
  1197. USING ADTSECT,R15 @VM03203 01124000
  1198. TM ADTFLG3,ADTFXCHN ANY OLD CHAIN LINKS? @VM03203 01125000
  1199. BNO FLGMODA NO, THEN CONTINUE @VM03203 01126000
  1200. O R13,SIGNBIT YES,THEN CALL TFINIS LATER @VM03203 01127000
  1201. DROP R15 @VM03203 01128000
  1202. FLGMODA SR R0,R0 GET 'OLD' FIRST CHAIN LINK @VM03203 01129000
  1203. ICM R0,B'0011',AFTFCLX DOES IT EXIST ? @VA01100 01130000
  1204. BNZ NOSWAP IF YES, WE ALREADY HAVE NEW ONE @VA01100 01131000
  1205. L R1,AFTADT NO, POINT TO THE ADT; @VA01100 01132000
  1206. L R15,AQQTRK AND GET A "NEW" FIRST CHAIN LINK @VA01100 01133000
  1207. BALR R14,R15 ..... @VA01100 01134000
  1208. BNZ NOSWAP UH-OH IF NO ROOM LEFT AT THE INN @VA01100 01135000
  1209. MVC AFTFCLX(2),AFTFCL SAVE OLD FCL DISK-ADDRESS @VA01100 01136000
  1210. STH R1,AFTFCL START USING THE NEW FCL @VA01100 01137000
  1211. CLC AFTCLN(2),ONEH IS THIS THE FCL ? @VA01100 01138000
  1212. BNE NOSWAP NO - NOT AT THE MOMENT @VA01100 01139000
  1213. STH R1,AFTCLD YES - STORE HERE ALSO @VA01100 01140000
  1214. NOSWAP NI AFTFLG2,255-AFTOLDCL CLEAR "AFTOLDCL" FLAG @VA01100 01141000
  1215. DISKRRT L R14,DSKRET GET RETURN-ADDRESS @VM03232 01142000
  1216. BR R14 HOME AGAIN. @VM03232 01143000
  1217. SPACE 01144000
  1218. * HANDLE "VERY CAREFULLY" IF ALTERNATE NTH CHAIN LINK IS UNAVAILABLE... 01145000
  1219. PORCPINE LR R0,R1 SET UP R0, @VA01100 01146000
  1220. L R1,AFTADT ALSO SET UP R1, AND @VA01100 01147000
  1221. L R15,ATRKLKPX GIVE BACK THE BLOCK @VA01100 01148000
  1222. BALR R14,R15 (SINCE WE WON'T BE USING IT) @VA01100 01149000
  1223. O R13,SIGNBIT FORCE CALL TO TFINIS ETC WHEN WE @VA01100 01150000
  1224. B FLAGMOD ARE DONE; GO SET FLAG & CONTINUE @VA01100 01151000
  1225. SPACE 3 01152000
  1226. FSRD LA R7,800 ASSUME AN 800-BYTE BLOCK. V0510 01153000
  1227. FSRD1 L R15,ARDTK GET THE ADDR OF RDTK. V0510 01154000
  1228. B RDWR GET COMMON. V0510 01155000
  1229. * "CONDITIONAL" ENTRY EQUIVALENT TO "FSWR" WHERE AFTDBD IS USED: 01156000
  1230. CONFSWR SR R15,R15 WRITE DATA BLOCK IF IT EXISTS: @VM03232 01157000
  1231. CH R15,AFTDBD AS GIVEN BY "AFTDBD" @VM03232 01158000
  1232. BER R14 IF NONEXISTENT, RETURN FORTHWITH @VM03232 01159000
  1233. FSWR L R15,AWRTK GET THE ADDR OF WRTK. V0510 01160000
  1234. LA R7,800 ASSUME 800-BYTE WRITE. V0510 01161000
  1235. RDWR LA R1,PLIST POINT TO THE PLIST. V0510 01162000
  1236. STM R6,R8,PLIST SET UP PASSED PARAMS. V0510 01163000
  1237. BR R15 READ/WRITE WITH RETURN TO CALLER. V0510 01164000
  1238. SPACE 1 01165000
  1239. GETBLOCK L R1,AFTADT POINT TO THE ADT. V0510 01166000
  1240. L R15,ATRKLKP GET THE ADDR OF TRKLKP. V0510 01167000
  1241. BR R15 GET A BLOCK AND RETURN. V0510 01168000
  1242. EJECT 01169000
  1243. ********************************************************************** 01170000
  1244. * 01171000
  1245. * CONSTANTS AND DEFINITIONS 01172000
  1246. * 01173000
  1247. ********************************************************************** 01174000
  1248. * 01175000
  1249. * PARAMETER LIST DISPLACEMENTS (GENERALLY R11) 01176000
  1250. * 01177000
  1251. PFILE EQU 8 01178000
  1252. PTYPE EQU 16 01179000
  1253. PMODE EQU 24 01180000
  1254. PITEM EQU 26 01181000
  1255. PADDR EQU 28 01182000
  1256. PNOBY EQU 32 01183000
  1257. PFIVA EQU 36 01184000
  1258. PNOIT EQU 38 01185000
  1259. * 01186000
  1260. * NUMERICAL CONSTANTS 01187000
  1261. * 01188000
  1262. * HALFWORD CONSTANTS ... 01189000
  1263. * 01190000
  1264. TWOH DC H'2' 01191000
  1265. FOUR DC H'4' 01192000
  1266. FIFNI DC H'59' 01193000
  1267. SIXTY DC H'60' 01194000
  1268. * 01195000
  1269. MAXFILES DC H'3400' MAX. NO. OF FILES CMS CAN HANDLE @VA03764 01196000
  1270. MAXBLKS DC H'16060' MAXIMUM NO. OF DATA BLOCKS FOR ONE FILE 01197000
  1271. MAXCHAIN DC H'41' HIGHEST CHAIN-LINK WE CAN NOW HANDLE 01198000
  1272. SIXTEEN DC F'16' FULLWORD SIXTEEN @VA09491 01198500
  1273. * 01199000
  1274. * FULLWORD CONSTANTS 01200000
  1275. * 01201000
  1276. ONE DC F'1' 01202000
  1277. ONEH EQU ONE+2 'ONE' AS A HALFWORD. 01203000
  1278. FOURHD DC F'400' 01204000
  1279. THRNN DC F'399' 01205000
  1280. ONEGRP DC F'256' 01206000
  1281. F798 DC F'798' 01207000
  1282. EIGHTHD DC F'800' V0510 01208000
  1283. * 01209000
  1284. * ADDRESS CONSTANTS 01210000
  1285. * 01211000
  1286. SIGNBIT DC X'80000000' TO SIGNAL THAT CHAIN-LINK HAS BEEN WRITTEN 01212000
  1287. * 01213000
  1288. * EQUATES 01214000
  1289. * 01215000
  1290. M3 EQU 3 @VA07151 01216000
  1291. M7 EQU 7 MASK SEVEN @VA09491 01216200
  1292. EIGHT EQU 8 MISCELLANEOUS 8 @VA09491 01216400
  1293. EJECT 01217000
  1294. * 01218000
  1295. * SPECIAL ERROR-HANDLING PURPOSELY AT THE END ... 01219000
  1296. * (R10 ADDRESSABILITY STILL IN EFFECT) 01220000
  1297. * 01221000
  1298. ADISKDIE DC V(DISKDIE) 'DIE' FOR DISK-ERROR. 01222000
  1299. * 01223000
  1300. QQBAD L R2,AFTADT R2 POINTS TO ADT FOR MESSAGE HANDLING 01224000
  1301. B RELQQ ERROR 01225000
  1302. * 01226000
  1303. * WATCH OUT FOR NEW DATA-BLOCK IN NEW CHAIN-LINK ... 01227000
  1304. * 01228000
  1305. NEWCHECK LA R2,4 SET INCREMENTER AND @VA01100 01229000
  1306. LA R3,796(,R8) SET LIMIT FOR BXLE (R6 STILL=0) @VA01100 01230000
  1307. CR604 C R6,0(,R8) IS CHAIN-LINK ALL ZEROES ? @VA01100 01231000
  1308. BNE JCHECK TRF IF NOT COMPLETELY EMPTY @VA01100 01232000
  1309. BXLE R8,R2,CR604 ITERATE FOR ENTIRE 800-BYTE C. L.@VA01100 01233000
  1310. LR R2,R1 SAVE R1 FOR LATER, 01234000
  1311. LR R3,R15 DITTO R15 01235000
  1312. L R15,ATRKLKPX CALL TRKLKPX 01236000
  1313. SR R0,R0 EMPTY A REGISTER V0510 01237000
  1314. ICM R0,B'0011',AFTCLD GET THE DASD ADDR OF THE CHAIN-V0510 01238000
  1315. L R1,AFTADT EMPTY CHAIN-LINK 01239000
  1316. BALR R14,R15 ... 01240000
  1317. LH R8,AFTCLN GET CHAIN-LINK-NUMBER 01241000
  1318. AR R8,R8 TIMES TWO (E.G. 4,6,8, ETC.) 01242000
  1319. STH R6,AFTCLB-4(R8) CLEAR EMPTY C.L. IN ACTTAB LINKAGE 01243000
  1320. STH R6,AFTCLD ***** AND HERE IF NECESSARY ************* 01244000
  1321. LR R1,R2 RESTORE R1 AND 01245000
  1322. LR R15,R3 R15 FROM BEFORE 01246000
  1323. * 01247000
  1324. BADNEWS OI AFTFLG,AFTFULD WARN FINIS NOT TO WRITE NULL CHAIN-LINK 01248000
  1325. * 01249000
  1326. JCHECK CH R15,FOUR SEE IF = ERROR 4 ('VERY FEW' LEFT) ? 01250000
  1327. BNE WRCHECK BNE IF NOT, MAKE ONE FURTHER CHECK 01251000
  1328. BAL R14,GIVEBACK GIVE BACK BLOCK WE WON'T USE @VM03232 01252000
  1329. WRCHECK L R2,AFTADT R2 POINTS TO ADT FOR MESSAGE HANDLING 01253000
  1330. SR R8,R8 CLEAR A HANDY REGISTER, 01254000
  1331. CH R8,AFTDBC DO WE HAVE ANY DATA-BLOCKS AT ALL YET ? 01255000
  1332. BL ERROR13 BL IF YES (> 0), FINIS WILL FINISH IT UP. 01256000
  1333. L R1,AFTADT IF FILE 'NULL', SET UP R1 01257000
  1334. SR R0,R0 ZERO REGISTER 0 V0510 01258000
  1335. ICM R0,B'0011',AFTFCL GET THE FIRST CHAIN LINK ADDR @VA01109 01259000
  1336. L R15,AQQTRKX CALL QQTRKX TO GIVE BACK THE 1ST CHAIN 01260000
  1337. BALR R14,R15 LINK (SINCE WE WON'T BE USING IT) 01261000
  1338. USING ADTSECT,R1 01262000
  1339. L R15,ADTFSTC TOTAL NUMBER OF FILES. V0510 01263000
  1340. BCTR R15,0 DECREMENT 01264000
  1341. ST R15,ADTFSTC STORE AS THE NEW VALUE. V0510 01265000
  1342. LH R15,ADTNACW NO. OF FILES OPEN FOR WRITING 01266000
  1343. BCTR R15,0 DECREMENT BY 1 01267000
  1344. STH R15,ADTNACW STORE NEW VALUE 01268000
  1345. DROP R1 01269000
  1346. LA R0,125 RETURN THE 1000-BYTE AREA 01270000
  1347. L R1,AFTFCLA WHICH IS STILL LYING AROUND @VA01109 01271000
  1348. DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 01272000
  1349. RELQQ LR R1,R9 POINT TO ACTIVE-FILE-TABLE, 01273000
  1350. L R15,AACTFRET GIVE IT BACK VIA ACTFRET, 01274000
  1351. BALR R14,R15 ... 01275000
  1352. B ERROR13J JOIN CODE BELOW (WITH R13 PLUS) @VA01100 01276000
  1353. * 01277000
  1354. GIVEBACK L R15,ATRKLKPX IF ERROR (4) FROM TRKLKP, @VM03232 01278000
  1355. LR R0,R1 SET UP R0 FOR TRKLKPX, @VM03232 01279000
  1356. L R1,AFTADT ALSO SET UP R1, GIVE IT BACK, @VM03232 01280000
  1357. BR R15 AND RETURN DIRECTLY TO CALLER. @VM03232 01281000
  1358. * 01282000
  1359. ERROR13 DS 0H COMES HERE IF NO (OR VERY FEW) TRACKS LEFT 01283000
  1360. O R13,SIGNBIT R13 MINUS TO CALL TFINIS LATER @VA01100 01284000
  1361. ERROR13J EQU * JOIN HERE IF FILE = NULL. @VA01100 01285000
  1362. LR R8,R2 SET R8 FOR ADDRESSABILITY IN WARMSG 01286000
  1363. LA R2,LFULLMSG POINT TO ERROR MESSAGE P0751 01287000
  1364. LA R3,107 AND SETUP THE ERROR NUMBER P0751 01288000
  1365. BAL R6,WARMSG CALL MESSAGE SUBROUTINE P0751 01289000
  1366. CLI AFTFV,C'V' VARIABLE LENGTH? @VA04222 01290000
  1367. BE VARGO YES, THEN NO CALC @VA04222 01291000
  1368. LH R15,AFTDBC GET NO. DATA BLOCKS @VA04222 01292000
  1369. SR R14,R14 ZERO OUT OTH REG @VA04222 01293000
  1370. M R14,EIGHTHD GET ANSWER NO. OF BYTES @VA04222 01294000
  1371. L R6,AFTIL GET LENGTH OF RECORD @VA04222 01295000
  1372. SR R14,R14 CLEAN R14 AGAIN @VA04222 01296000
  1373. DR R14,R6 DIVIDE BY LENGTH @VA04222 01297000
  1374. CLM R15,3,AFTIC IS ITEM COUNT LARGER NOW? @VA04222 01298000
  1375. BNH VARGO NO, THEN DON'T STORE NEW ITEM @VA04222 01299000
  1376. * COUNT 01300000
  1377. STH R15,AFTIC SET NEW ITEM COUNT @VA04222 01301000
  1378. VARGO LA R15,13 SET ERROR CODE 13 @VA04222 01302000
  1379. B ERR @VA04222 01303000
  1380. * 01304000
  1381. ERROR7 LA R15,7 01305000
  1382. B ERR 01306000
  1383. * 01307000
  1384. ERROR4 LA R15,4 ERROR 4 01308000
  1385. B ERR 01309000
  1386. * 01310000
  1387. ERROR19 LA R15,19 ERROR 19 (BEYOND FILE SYSTEM LIMITS) 01311000
  1388. B ERR 01312000
  1389. SPACE 1 01313000
  1390. USING ADTSECT,R12 @VA03665 01314000
  1391. ERROR25P L R15,ADTFSTC TOTAL NUMBER OF FILES @VA03665 01315000
  1392. TM AFTFLG2,AFTNEW TEST FOR NEW FILE @VA08045 01316000
  1393. BNO ERROR25R IF NOT THEN SKIP DECRMNT @VA08045 01317000
  1394. BCTR R15,0 DECREMENT @VA03665 01318000
  1395. ST R15,ADTFSTC STORE AS THE NEW VALUE @VA03665 01319000
  1396. DROP R12 @VA03665 01320000
  1397. L R1,AFTADT GET ADDRESS OF ADT @VA03665 01321000
  1398. SR R0,R0 @VA03665 01322000
  1399. ICM R0,B'0011',AFTFCL GET ADDR OF FIRST CHAIN LINK @VA03665 01323000
  1400. L R15,AQQTRKX GIVE BACK FIRST CHAIN LINK @VA03665 01324000
  1401. BALR R14,R15 @VA03665 01325000
  1402. LR R1,R9 ADDR OF ACTIVE FILE TABLE @VA03665 01326000
  1403. ERROR25R EQU * @VA08045 01327000
  1404. L R15,AACTFRET GIVE IT BACK @VA03665 01328000
  1405. BALR R14,R15 @VA03665 01329000
  1406. ERROR25 LA R15,25 CORE NOT AVAILABLE FOR @VA03665 01330000
  1407. B ERR UFD BUFFERS @VA03665 01331000
  1408. * 01332000
  1409. FILSBUST DS 0H TOO MANY FILES ON ONE DISK 01333000
  1410. LR R8,R1 SET R8 FOR ADDRESSABILITY IN WARMSG 01334000
  1411. LA R2,LBUSTMSG POINT TO THE MESSAGE P0751 01335000
  1412. LA R3,170 SET UP THE ERROR NUMBER P0751 01336000
  1413. BAL R6,WARMSG CALL MESSAGE SUBROUTINE P0751 01337000
  1414. LA R15,10 SET ERROR CODE 10 01338000
  1415. B ERR 01339000
  1416. * 01340000
  1417. JCANTWRT DS 0H DISK CANNOT BE WRITTEN ON 01341000
  1418. USING ADTSECT,R1 01342000
  1419. CLI ADTMX,C' ' IF ACTIVE FROM POINT, IS IT A ... 01343000
  1420. BE CANTWRIT READ-ONLY EXTENSION (ERROR IF NOT). 01344000
  1421. CLC 24(1,R11),ADTMX IF YES, DOES IT MATCH CALLER'S MODE ? 01345000
  1422. BNE CANTWRIT TRF IF NOT (DEFINITELY IN ERROR). 01346000
  1423. DROP R1 01347000
  1424. L R15,AACTFRET IF R/O EXT. OF OUR DISK, 01348000
  1425. LR R1,R9 RESTORE R1 TO POINT TO AFT ENTRY, 01349000
  1426. BALR R14,R15 GET IT OUT OF THE ACTIVE FILE TABLE, 01350000
  1427. LR R1,R11 RESTORE R1 TO CALLER'S P-LIST, 01351000
  1428. B SR99 AND RE-ENTER LOGIC FOR 'OUR' DISK 01352000
  1429. * 01353000
  1430. CANTWRIT EQU * 01354000
  1431. LA R15,12 SET ERROR CODE 12 01355000
  1432. B ERR 01356000
  1433. * 01357000
  1434. ERROR22 DMSERR TEXT='Virtual Storage capacity exceeded', @VA02525X01358490
  1435. NUM=109,LET=S,TYPCALL=BALR @VA02525 01359000
  1436. LA R15,22 ERROR CODE 22 @VA02525 01360000
  1437. B ERR @VA02525 01361000
  1438. * 01362000
  1439. USING ADTSECT,R8 P0751 01363000
  1440. WARMSG L R7,ADTDTA POINT TO THE DEVICE TABLE ENTRY P0751 01364000
  1441. DMSERR MF=(E,'SYS'),NUM=(3),LET=S,TEXTA=(2), P0751*01365000
  1442. TYPCALL=BALR,SUB=(CHARA,(ADTM,1),HEX4A,((7),2)) P0751 01366000
  1443. BR R6 P0751 01367000
  1444. DROP R8 P0751 01368000
  1445. * 01369000
  1446. LBUSTMSG DC AL1(L'BUSTMSG) P0751 01370000
  1447. BUSTMSG DC C'Disk ''..(....)'' has maximum number of files' *01371290
  1448. HRC012DS 01371580
  1449. * 01372000
  1450. LFULLMSG DC AL1(L'FULLMSG) P0751 01373000
  1451. FULLMSG DC C'Disk ''..(....)'' is full' HRC012DS 01374490
  1452. SPACE 2 01375000
  1453. DS 0D ALIGN INVTBL ... @VM03232 01376000
  1454. INVTBL DC 256X'40' X'40' MEANS "INVALID" HRC012DS 01377190
  1455. ORG INVTBL+78 HRC012DS 01377380
  1456. DC X'00' '+' IS VALID PLUS HRC012DS 01377570
  1457. ORG INVTBL+91 HRC012DS 01377760
  1458. DC X'00' '$' IS VALID DOLLAR HRC012DS 01377950
  1459. ORG INVTBL+96 HRC012DS 01378140
  1460. DC X'00' '-' IS VALID DASH/HYPHEN HRC012DS 01378330
  1461. ORG INVTBL+109 HRC012DS 01378520
  1462. DC X'00' '_' IS VALID UNDERSCORE HRC012DS 01378710
  1463. ORG INVTBL+122 HRC012DS 01378900
  1464. DC X'00' ':' IS VALID COLON HRC012DS 01379090
  1465. ORG INVTBL+123 01380000
  1466. DC 2X'00' '#' AND '@' ARE VALID @VA01100 01381000
  1467. ORG INVTBL+129 01382000
  1468. DC 9X'00' LOWER CASE 'A' THRU 'I' ARE VALID @VA01100 01383000
  1469. ORG INVTBL+145 01384000
  1470. DC 9X'00' LOWER CASE 'J' THRU 'R' ARE VALID @VA01100 01385000
  1471. ORG INVTBL+162 01386000
  1472. DC 8X'00' LOWER CASE 'S' THRU 'Z' ARE VALID @VA01100 01387000
  1473. ORG INVTBL+193 01388000
  1474. DC 9X'00' UPPER CASE 'A' THRU 'I' ARE VALID @VA01100 01389000
  1475. ORG INVTBL+209 01390000
  1476. DC 9X'00' UPPER CASE 'J' THRU 'R' ARE VALID @VA01100 01391000
  1477. ORG INVTBL+226 01392000
  1478. DC 8X'00' UPPER CASE 'S' THRU 'Z' ARE VALID @VA01100 01393000
  1479. ORG INVTBL+240 01394000
  1480. DC 10X'00' NUMBERS '0' THRU '9' ARE VALID @VA01100 01395000
  1481. ORG , HRC012DS 01396490
  1482. SPACE 01397000
  1483. LTORG NEEDED CONSTANTS ... @VM03232 01398000
  1484. SPACE 01399000
  1485. * EQUATES: 01400000
  1486. Q80 EQU 80 LENGTH OF NTH CHAIN LINK AREA @VM03232 01401000
  1487. * IN FIRST CHAIN LINK. 01402000
  1488. Q118 EQU 118 DISPLACEMENT OF LAST DATA BLOCK @VM03232 01403000
  1489. * IN FIRST CHAIN LINK AREA. 01404000
  1490. Q798 EQU 798 DISPLACEMENT OF LAST DATA BLOCK @VM03232 01405000
  1491. * IN NTH (NOT 1ST) CHAIN LINK AREA. 01406000
  1492. Q800 EQU 800 LENGTH OF CMS PHYSICAL BLOCKS @VM03232 01407000
  1493. FF EQU X'FF' @VM03232 01408000
  1494. SPACE 01409000
  1495. DS 0D - "WRBUF" ENDS HERE - 01410000
  1496. EJECT 01411000
  1497. FVS 01412000
  1498. * 01413000
  1499. PLIST EQU RWFSTRG FOUR WORDS 01414000
  1500. PADDRX EQU RWFSTRG+16 ONE WORD 01415000
  1501. DSKRET EQU RWFSTRG+20 ONE WORD 01416000
  1502. SAVECT EQU RWFSTRG+24 ONE WORD 01417000
  1503. FALIGN EQU RWFSTRG+28 (CLEARED BY INITIALIZATION) 01418000
  1504. ALIGN EQU FALIGN+2 RIGHT-HALF OF 'FALIGN' 01419000
  1505. WRBFLAG1 EQU ALIGN+2 FIRST FLAG-BYTE 01420000
  1506. WRBFLAG2 EQU WRBFLAG1+1 SECOND FLAG-BYTE 01421000
  1507. * 01422000
  1508. END$TEMP EQU WRBFLAG2+1 END OF TEMPORARY STORAGE. 01423000
  1509. * 01424000
  1510. REGSAV4 EQU RWFSTRG+12 SAFE SAVE-AREA NOT USED BY TFINIS OR UPDISK 01425000
  1511. EJECT 01426000
  1512. NUCON 01427000
  1513. DCBD DSORG=(PS) 01427200
  1514. CMSCB 01427400
  1515. AFT 01428000
  1516. FSTB 01429000
  1517. ADT 01430000
  1518. REGEQU 01431000
  1519. END 01432000