Table of Contents

DMSTQQ Source

References

Source Listing

DMSTQQ.ASSEMBLE.txt
  1. TQQ TITLE 'DMSTQQ (CMS) VM/370 - RELEASE 6' 00001000
  2. SPACE 2 00002000
  3. *. 00003000
  4. * MODULE NAME: 00008000
  5. * 00009000
  6. * DMSTQQ 00010000
  7. * 00011000
  8. * SUBROUTINE NAME: 00012000
  9. * 00013000
  10. * DMSTQQ 00014000
  11. * 00015000
  12. * FUNCTION: 00016000
  13. * 00017000
  14. * TO ALLOCATE A 200-BYTE FIRST CHAIN LINK (FCL) TO A 00018000
  15. * CALLING PROGRAM. 00019000
  16. * 00020000
  17. * ATTRIBUTES: 00021000
  18. * 00022000
  19. * REENTRANT, NUCLEUS-RESIDENT. 00023000
  20. * 00024000
  21. * ENTRY POINTS: 00025000
  22. * 00026000
  23. * DMSTQQ 00027000
  24. * 00028000
  25. * CALLING SEQUENCE: 00029000
  26. * 00030000
  27. * L R15, AQQTRK WHERE AQQTRK=V(DMSTQQ) 00031000
  28. * BALR R14, R15 00032000
  29. * 00033000
  30. * ENTRY CONDITIONS: 00034000
  31. * 00035000
  32. * R1 MUST POINT TO ACTIVE DISK TABLE BLOCK 00036000
  33. * R13 MUST POINT TO FVS AREA 00037000
  34. * 00038000
  35. * EXIT CONDITIONS: 00039000
  36. * 00040000
  37. * NORMAL RETURN 00041000
  38. * 00042000
  39. * R1 CONTAINS DISK-ADDRESS OF AVAILABLE 200-BYTE AREA. 00043000
  40. * (SEE FIGURE 24 FOR FORMAT) 00044000
  41. * R15=0 (AND CONDITION-CODE=0) 00045000
  42. * 00046000
  43. * NO 200 BYTE AREA AVAILABLE (ERROR 1) 00047000
  44. * 00048000
  45. * R1=0 00049000
  46. * R15=1 (AND CONDITION-CODE=2) 00050000
  47. * 00051000
  48. * ERROR BY CALLER (ERROR 2) 00052000
  49. * 00053000
  50. * R1 SAME AS AT ENTRY 00054000
  51. * R15=2 (AND CONDITION-CODE=2) 00055000
  52. * 00056000
  53. * CALLS TO OTHER ROUTINES: 00057000
  54. * 00058000
  55. * DMSTRKA, DMSTRKX 00059000
  56. * 00060000
  57. * EXTERNAL REFERENCES: 00061000
  58. * 00062000
  59. * ADTSECT, FVSECT, DMSNUC 00063000
  60. * 00064000
  61. * TABLES/WORKAREAS: 00065000
  62. * 00066000
  63. * NONE 00067000
  64. * 00068000
  65. * REGISTER USAGE: 00069000
  66. * 00070000
  67. * R13, FVSECT 00071000
  68. * R11, BASE 00072000
  69. * R1 , ADSTSECT 00073000
  70. * REST WORK 00074000
  71. * MACROS USED: 00075000
  72. * 00076000
  73. * ADT, FVS 00077000
  74. * 00078000
  75. * OPERATION: 00079000
  76. * 00080000
  77. * DMSTQQ FIRST CHECKS TO SEE THAT THE DISK IS LOGGED IN 00081000
  78. * AND READ/WRITE. THE QQMASK TABLE IN THE ADT IS THEN 00082000
  79. * SEARCHED FOR AN AVAILABLE ENTRY. IF ONE IS FOUND, 00083000
  80. * THE ADDRESS IN THE TABLE ENTRY IS RETURNED TO THE 00084000
  81. * CALLER IN REGISTER 1 AND THE ENTRY IN THE TABLE IS 00085000
  82. * ZEROED. IF NO ENTRY IS FOUND, DMSTRKA IS CALLED TO 00086000
  83. * GET ANOTHER 800-BYTE BLOCK ADDRESS. 00087000
  84. * AN ENTRY WILL BE FOUND ONLY FOR A 2314. IF THE 00088100
  85. * DEVICE IS NOT A 2314 OR IF THE BLOCK NUMBER IS GREATER 00088200
  86. * THAN 8191 THE ENTIRE BLOCK IS RETURNED TO THE CALLER. 00090000
  87. * IF THE BLOCK NUMBER IS NOT GREATER THAN 8191, THE 00091000
  88. * ADDRESS OF THE LAST 200 BYTES IS RETURNED TO THE 00092000
  89. * CALLER, AND THE ADDRESSES OF THE FIRST 3 SLOTS ARE 00093000
  90. * PUT IN THE QQMASK TABLE. 00094000
  91. * 00095000
  92. * NOTES: AT ENTRY, DMSTQQ CHECKS THAT THE POINTER TO 00096000
  93. * ADT BLOCK IN R1 IS POSITIVE AND NONZERO, THAT THE 00097000
  94. * DISK REFERENCED THEREBY IS READ-WRITE, AND THAT THE 00098000
  95. * USER FILE DIRECTORY, INCLUDING THE QQMSK TABLE, IS 00099000
  96. * INDEED IN MEMORY. 00100000
  97. * 00101000
  98. * WHEN CALLING DMSTRKA, IF DMSTQQ OBTAINS AN ERROR 4 00102000
  99. * INDICATING "VERY FEW" RECORDS LEFT, DMSTQQ RETURNS 00103000
  100. * THE RECORD JUST OBTAINED VIA DMSTRKX BEFORE 00104000
  101. * RETURNING WITH ERROR-CODE 1 TO THE CALLER, SO THAT 00105000
  102. * SUFFICIENT RECORDS ARE HELD IN RESERVE TO UPDATE THE 00106000
  103. * FILE DIRECTORY IN HANDLING THE FULL-DISK SITUATION. 00107000
  104. * 00108000
  105. * MODULE NAME: 00109000
  106. * 00110000
  107. * DMSTQQ 00111000
  108. * 00112000
  109. * SUBROUTINE NAME: 00113000
  110. * 00114000
  111. * DMSTQQX 00115000
  112. * 00116000
  113. * FUNCTION: 00117000
  114. * 00118000
  115. * TO MAKE A 200-BYTE AREA THAT IS NO LONGER NEEDED BY 00119000
  116. * ONE PROGRAM AVAILABLE FOR ALLOCATION TO ANOTHER. 00120000
  117. * 00121000
  118. * ENTRY POINTS: 00122000
  119. * 00123000
  120. * DMSTQQX 00124000
  121. * 00125000
  122. * CALLING SEQUENCE: 00126000
  123. * 00127000
  124. * L R15, AQQTRKX WHERE AQQTRKX=V(DMSTQQX) 00128000
  125. * BALR R14, R15 00129000
  126. * 00130000
  127. * ENTRY REQUIREMENTS: 00131000
  128. * 00132000
  129. * R0 (RIGHTMOST 16 BITS) MUST HOLD THE DISK ADDRESS 00133000
  130. * OF THE 200-BYTE DISK AREA BEING RETURNED. (SEE 00134000
  131. * FIGURE 24 FOR FORMAT.) 00135000
  132. * 00136000
  133. * R1 MUST POINT TO ACTIVE DISK TABLE BLOCK. 00137000
  134. * 00138000
  135. * R13 MUST POINT TO "FVS" AREA. 00139000
  136. * 00140000
  137. * EXIT CONDITIONS: 00141000
  138. * 00142000
  139. * NORMAL RETURN 00143000
  140. * 00144000
  141. * R15=0 (AND CONDITION-CODE=0) 00145000
  142. * 00146000
  143. * IF NO ERRORS ARE DETECTED, R15 IS ZERO. 00147000
  144. * 00148000
  145. * IF THE DISK IS NOT LOGGED IN OR IF IT IS NOT A 00149000
  146. * READ/WRITE DISK, R15 EQUALS 2. 00150000
  147. * 00151000
  148. * IF THE QQMASK IS FULL R15 EQUALS 1. 00152000
  149. * 00153000
  150. * CALLS TO OTHER ROUTINES: 00154000
  151. * 00155000
  152. * DMSTRKX 00156000
  153. * 00157000
  154. * EXTERNAL REFERENCES: 00158000
  155. * 00159000
  156. * ADSTSECT, FVSECT, DMSNUC 00160000
  157. * 00161000
  158. * TABLES/WORKAREAS: 00162000
  159. * 00163000
  160. * NONE 00164000
  161. * 00165000
  162. * REGISTER USAGE: 00166000
  163. * 00167000
  164. * R11, BASE 00168000
  165. * R13, FVSECT 00169000
  166. * R1 , ADTSECT 00170000
  167. * REST WORK 00171000
  168. * 00172000
  169. * OPERATION: 00173000
  170. * 00174000
  171. * DMSTQQX FIRST CHECKS TO SEE THAT THE DISK IS LOGGED 00175000
  172. * IN AND A READ/WRITE DISK. IF THE DISK IS NOT A 2314 OR 00176100
  173. * THE BLOCK ADDRESS INDICATES THE WHOLE BLOCK IS IN USE 00177000
  174. * (BIT 3=1), 00178000
  175. * DMSTRKX IS CALLED TO RETURN THE 800 BYTE DISK BLOCK. 00179000
  176. * OTHERWISE, THE BLOCK ADDRESS IS ADDED TO THE QQMASK 00180000
  177. * TABLE. THE TABLE IS THEN SEARCHED TO SEE IF ALL FOUR 00181000
  178. * 200 BYTE BLOCKS WITHIN THE SAME 800 BYTE BLOCK ARE IN 00182000
  179. * THE TABLE. 00183000
  180. * IF THEY ARE, THEY ARE REMOVED AND DMSTRKX CALLED TO 00184000
  181. * RELEASE THE 800 BYTE BLOCK. 00185000
  182. * 00186000
  183. * NOTES: LIKE DMSTQQ, DMSTQQX CHECKS FOR ERRORS BY THE 00187000
  184. * CALLER. 00188000
  185. * 00189000
  186. * IF A USER HAD AN EXTREMELY LARGE NUMBER OF FILES AND 00190000
  187. * ERASED THEM SPORADICALLY, IT IS THEORETICALLY 00191000
  188. * POSSIBLE THAT THE QQMSK TABLE COULD BECOME FULL FROM 00192000
  189. * THE OTHER THREE PARTS OF 800-BYTE RECORDS BEING 00193000
  190. * RETURNED FOR EACH RETURNED 200-BYTE RECORD. IF THIS 00194000
  191. * OCCURS, THE TABLE IS NOT PERMITTED TO OVERFLOW. 00195000
  192. * AN ERROR 3 IS GIVEN, WHICH IS NONFATAL. 00196000
  193. * PROCESSING CONTINUES, AND A USER'S FILES ARE INTACT 00197000
  194. * (EXCEPT THOSE INTENTIONALLY ERASED). THE QQMSK TABLE 00198000
  195. * WOULD THEN CONTAIN SOME ENTRIES FOR WHICH ALL FOUR 00199000
  196. * PARTS WOULD NOT SUBSEQUENTLY BE FOUND, BUT THESE 00200000
  197. * WOULD STILL BE AVAILABLE FOR ALLOCATION BY DMSTQQ. 00201000
  198. * 00202000
  199. * DMSTQQX IS AN ENTRY-POINT IN THE DMSTQQ ROUTINE. 00203000
  200. * 00204000
  201. *. 00205000
  202. EJECT 00206000
  203. QQTRK START 0 00207000
  204. SPACE 00208000
  205. ENTRY DMSTQQ P3035 00209000
  206. DMSTQQ EQU QQTRK P3035 00210000
  207. ENTRY DMSTQQX P3035 00211000
  208. ENTRY QQTRKX 00212000
  209. SPACE 00213000
  210. USING FVSECT,R13 00214000
  211. USING NUCON,R0 00215000
  212. * 00216000
  213. ********************************************************************** 00217000
  214. * 00218000
  215. * QQTRK 00219000
  216. * 00220000
  217. ********************************************************************** 00221000
  218. * 00222000
  219. STM R2,R14,0(R13) SAVE REGISTERS 00223000
  220. LR R11,R15 ADDRESSABILITY INTO R11 00224000
  221. USING QQTRK,R11 ... 00225000
  222. BAL RET,GETLOC GET LOC. OF APPROPRIATE DISK TABLE 00226000
  223. * 00227000
  224. * SEARCH FOR AVAILABLE 1/16 TRACK 00228000
  225. * 00229000
  226. LM XR1,XR3,TABSCH SET REGISTERS FOR BXLE 00230000
  227. SR ZERO,ZERO INITIALIZE 00231000
  228. LA RET,FOUND (FOR 'BCR' BELOW -- FASTER THAN 'BC') 00232000
  229. CLI DTADT(R6),T2314 IS THIS A 2314 ? @V2A2014 00233100
  230. BNE NOQQT NO...BR @V2A2014 00233200
  231. LOOK CH ZERO,0(QQTBL,XR1) SEARCH FOR NON-ZERO ENTRY 00235000
  232. BCR 7,RET 'BNZ' TO 'FOUND' IF SUCCESS. 00236000
  233. BXLE XR1,XR2,LOOK ... 00237000
  234. * 00238000
  235. * IF NO 16TH TRACKS LEFT, GET ANOTHER QTR-TRK FROM TRKLKP... 00239000
  236. * 00240000
  237. NOQQT L R15,ATRKLKP SET R15 = A(TRKLKP), 00241000
  238. LR SAVSAV,R13 SAVE ORIGINAL SAVE-AREA 00242000
  239. LA R13,TRKLSAVE 11-WORD SAVE-AREA FOR TRKLKP INTO 13 00243000
  240. BALR R14,R15 CALL TRKLKP 00244000
  241. LR R13,SAVSAV RESTORE R13 TO A(FVS) POST-HASTE 00245000
  242. BNZ CHKERR CHECK ERROR-CODE IF NOT ZERO. 00246000
  243. CLI DTADT(R6),T2314 IS THIS A 2314 ? @V2A2014 00247100
  244. BNE RETURNQ NO...BR @V2A2014 00247200
  245. CH R1,H8192 IS THE BLOCK-NUMBER NO MORE THAN 8191 ? 00249000
  246. BL STORE3 BL IF YES, USE OLD-TYPE LOGIC. 00250000
  247. CH R1,H16384 IF NOT, OK 'AS IS' UP TO 16383 00251000
  248. BL RETURNQ BL IF ALL RIGHT, R1 OK AS IS. 00252000
  249. CH R1,H24576 WATCH FOR RANGE 16384-24575 00253000
  250. BNL RETURNQ BNL IF 24576 OR MORE (R1 OK AS IS) 00254000
  251. AH R1,X6000 ADD +6000 (HEX) FOR 16384-24575 ONLY 00255000
  252. B RETURNQ GO EXIT. 00256000
  253. * 00257000
  254. STORE3 STH R1,0(,QQTBL) STORE IN FIRST 3 00258000
  255. STH R1,2(,QQTBL) SLOTS IN THE QQMSK 00259000
  256. STH R1,4(,QQTBL) (KNOWN TO BE EMPTY), AND 00260000
  257. OC 0(6,QQTBL),QUART 'OR' IN THE '16TH TRACK' BITS. 00261000
  258. RETURNQ LM R2,R14,0(R13) RESTORE R2 THRU R14 00262000
  259. LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00263000
  260. BR R14 AND EXIT (R15 ZERO OR ALL SET). 00264000
  261. * 00265000
  262. FOUND LH R1,0(QQTBL,XR1) GET DISK ADDRESS 00266000
  263. STH ZERO,0(QQTBL,XR1) ZERO OUT ENTRY 00267000
  264. * 00268000
  265. RETURN LM R2,R14,0(R13) RESTORE REGISTERS 00269000
  266. SR R15,R15 AND RETURN 00270000
  267. BR R14 ... 00271000
  268. * 00272000
  269. DROP R11 00273000
  270. EJECT 00274000
  271. ********************************************************************** 00275000
  272. * 00276000
  273. * QQTRKX 00277000
  274. * 00278000
  275. ********************************************************************** 00279000
  276. * 00280000
  277. USING *,15 00281000
  278. QQTRKX STM R2,R14,0(R13) SAVE REGISTERS 00282000
  279. DMSTQQX EQU QQTRKX P3035 00283000
  280. L R11,AQQTRK SET UP COMPATIBLE BASE REGISTER 00284000
  281. DROP R15 00285000
  282. USING QQTRK,R11 00286000
  283. BAL RET,GETLOC GET LOC. OF APPROPRIATE DISK TABLE 00287000
  284. CLI DTADT(R6),T2314 IS THIS A 2314 ? @V2A2014 00288100
  285. BNE LETRKX NO...BR @V2A2014 00288200
  286. LR SAVSAV,0 SAVE DISK ADDRESS 00290000
  287. LH R4,X2000 PREPARE TO CHECK 3RD BIT FROM LEFT, 00291000
  288. NR R4,R0 IS 3RD BIT OF BLOCK NUMBER '0' OR '1' ? 00292000
  289. BZ NR0 BZ IF = 0, USE REGULAR (OLD) LOGIC 00293000
  290. L R4,X8000 IF 1, PREPARE TO CHECK LEFTMOST BIT, 00294000
  291. NR R4,R0 IS IT A '0' OR '1' ? 00295000
  292. BZ LETRKX IF = 0, R0 OK AS IS, LET TRKLKPX DO WORK. 00296000
  293. N R0,F65535 MAKE SURE WE HAVE RIGHTMOST 16 BITS ONLY 00297000
  294. SH R0,X6000 SUBTRACT 6000 FOR SPECIAL RANGE 00298000
  295. B LETRKX AND LET 'TRKLKPX' FINISH THE JOB. 00299000
  296. * 00300000
  297. NR0 LH R12,RIGHT14 X'3FFF' INTO R12 (REFERENCED SEVERAL TIMES) 00301000
  298. NR R0,R12 REMOVE 1/4 OF 1/4-TRACK BITS 00302000
  299. * 00303000
  300. * SEARCH FOR REMAINDER OF 1/4 TRACK 00304000
  301. * 00305000
  302. LM XR1,XR3,TABSCH SET FOR BXLE 00306000
  303. SR ZERO,ZERO INITIALIZE 00307000
  304. LA COUNT,3 WE WANT 3 1/16 TRACKS 00308000
  305. LOOK2 CH ZERO,0(QQTBL,XR1) IS THERE A 1/16 TRACK ADDRESS 00309000
  306. BNE NOZERO BNE IF NOT ZERO, TEST IT 00310000
  307. BACK BXLE XR1,XR2,LOOK2 IF ZERO, KEEP LOOKING 00311000
  308. * 00312000
  309. * INSERT 1/16 TRACK ADDRESS INTO TABLE 00313000
  310. * 00314000
  311. SR XR1,XR1 RE-INITIALIZE XR1 FOR BXLE (XR2 & 3 OK) 00315000
  312. LA COUNT,L2 (FOR 'BCR' BELOW -- FASTER THAN 'BC') 00316000
  313. L1 CH ZERO,0(QQTBL,XR1) IS THIS SPACE AVAILABLE 00317000
  314. BCR 8,COUNT 'BZ' TO 'L2' IF YES. 00318000
  315. BXLE XR1,XR2,L1 NO, TRY THE NEXT ONE 00319000
  316. LA R15,3 ERROR 3 IF DROPS THRU BXLE - QQMSK FULL 00320000
  317. B RETURNQ 30 MAY 1969 (JAS) - HOPEFULLY NON-FATAL. 00321000
  318. * EMPTY HALFWORD FOUND ... 00322000
  319. L2 STH SAVSAV,0(QQTBL,XR1) STORE 1/16TH TRACK ADDRESS 00323000
  320. B RETURN RESTORE REGISTERS AND RETURN. 00324000
  321. * 00325000
  322. NOZERO LH ADDR,0(QQTBL,XR1) GET DISK ADDRESS 00326000
  323. NR ADDR,R12 CONVERT TO 1/4 TRACK ADDRESS 00327000
  324. CR R0,ADDR ARE THEY THE SAME 00328000
  325. BNE BACK BNE IF NOT, TRY AGAIN 00329000
  326. BCT COUNT,BACK YES, FIND ALL THREE OF THEM 00330000
  327. * ALL THREE FOUND, GET RID OF THEM 00331000
  328. * 00332000
  329. * REMOVE THE 3 1/16TH TRACKS 00333000
  330. * 00334000
  331. SR XR1,XR1 RE-INITIALIZE XR1 FOR BXLE (XR2 & 3 OK) 00335000
  332. LA COUNT,BUMPXR (FOR 'BCR' BELOW -- FASTER THAN 'BC') 00336000
  333. GETLP LH ADDR,0(QQTBL,XR1) GET 1/16TH ADDRESS 00337000
  334. NR ADDR,R12 CONVERT TO 1/4 TRACK ADDRESS 00338000
  335. CR R0,ADDR ARE THEY THE SAME 00339000
  336. BCR 7,COUNT 'BNE' TO 'BUMPXR' IF NO, TRY AGAIN. 00340000
  337. STH ZERO,0(QQTBL,XR1) ZERO OUT ENTRY 00341000
  338. BUMPXR BXLE XR1,XR2,GETLP FIND ALL THREE BY SEARCHING ALL 00342000
  339. * 00343000
  340. * RETURN 1/4 TRACK ADDRESS TO FREE DISK 00344000
  341. * STORAGE 00345000
  342. * 00346000
  343. LETRKX L R15,ATRKLKPX LET 'TRKLKPX' DO THE REST OF THE WORK! 00347000
  344. LM R2,R14,0(R13) RESTORE ORIGINAL REGISTERS 00348000
  345. * NOTE -- OK TO PASS THE R13 FROM OUR CALLER ALONG TO TRKLKPX. 00349000
  346. * NOTE -- R14 STILL = RETURN-ADDRESS TO OUR CALLER. 00350000
  347. BR R15 (TRKLKPX RETURNS DIRECTLY TO CALLER.) 00351000
  348. EJECT 00352000
  349. ********************************************************************** 00353000
  350. * 00354000
  351. * DETERMINE FROM GPR1 00355000
  352. * WHICH ACTIVE DISK TABLE 00356000
  353. * 00357000
  354. ********************************************************************** 00358000
  355. GETLOC LTR SAVPAM,R1 SAVE P-LIST POINTER & CHECK IT 00359000
  356. BNP ERR2 ERROR UNLESS PLUS & NONZERO 00360000
  357. USING ADTSECT,R1 REFERENCE ACTIVE DISK TABLE 00361000
  358. TM ADTFLG1,ADTFRW MUST BE A READ-WRITE DISK 00362000
  359. BZ ERR2 ERROR IF NOT 00363000
  360. L R6,ADTDTA LOAD DEVICE TABLE ADDRESS. 00364000
  361. CLI DTADT(R6),T2314 IS THIS A 2314 ? @V2A2014 00365100
  362. BCR 7,RET NO...BR @V2A2014 00365200
  363. TM ADTFLG2,ADTFMFD AND MFD MUST BE IN CORE 00367000
  364. BZ ERR2 ERROR IF NOT 00368000
  365. L QQTBL,ADTQQM GET LOCATION OF QQMSK TABLE 00369000
  366. LTR QQTBL,QQTBL MAKE SURE TABLE IS REALLY THERE 00370000
  367. BCR 7,RET OK IF YES, RETURN TO QQTRK OR QQTRKX. 00371000
  368. * 00372000
  369. * PROCEED TO 'ERROR 2' IF QQMSK NOT THERE AT ALL ... 00373000
  370. * 00374000
  371. ********************************************************************** 00375000
  372. * 00376000
  373. * ERROR ROUTINES 00377000
  374. * 00378000
  375. ********************************************************************** 00379000
  376. SPACE 00380000
  377. ERR2 LA R15,2 ERROR NO. 2 00381000
  378. DC H'0002' *****ENTER DEBUG - PROGRAM BUG SOMEPLACE******** 00382000
  379. B RETURNQ GO RESTORE REGISTERS & EXIT. 00383000
  380. * 00384000
  381. DROP R1 00385000
  382. EJECT 00386000
  383. ********************************************************************** 00387000
  384. * 00388000
  385. * STORAGE AND DEFINITIONS 00389000
  386. * 00390000
  387. ********************************************************************** 00391000
  388. PRINT DATA 00392000
  389. QUART DC X'C00080004000' BITS FOR '16TH TRACKS' 00393000
  390. * 00394000
  391. H8192 DC H'8192' FOR 1-8191 00395000
  392. H16384 DC H'16384' FOR 8192-16383 00396000
  393. H24576 DC H'24576' FOR 16384-24575 00397000
  394. X2000 EQU H8192 TO CHECK 3RD BIT FROM LEFT IN BLOCK NO. 00398000
  395. X6000 EQU H24576 ADJUSTER FOR BLOCK NOS. 16384-24575. 00399000
  396. * 00400000
  397. RIGHT14 DC X'3FFF' RIGHTMOST 14 BITS OF BLOCK NUMBER ONLY 00401000
  398. * 00402000
  399. F4 DC F'4' 00403000
  400. X8000 DC A(X'8000') TO CHECK LEFT-MOST BIT OF BLOCK-NUMBER 00404000
  401. * 00405000
  402. TABSCH DC F'0,2,198' LIMITS FOR TABLE SEARCH 00406000
  403. * 00407000
  404. * 00408000
  405. * THE FOLLOWING CODE (USED VERY SELDOM) IS PURPOSELY 'AT THE END' 00409000
  406. * FOR PAGING EFFICIENCY (IN CASE QQTRK 'SPILLS OVER' END OF PAGE) 00410000
  407. * 00411000
  408. * COMES HERE IF ERROR-CODE FROM 'TRKLKP' 00412000
  409. * 00413000
  410. CHKERR C R15,F4 IS R15 = 4 ('VERY FEW' TRACKS LEFT ? ) 00414000
  411. BNE SR11 BNE IF NOT, GO CLEAR R1 AND EXIT. 00415000
  412. L R15,ATRKLKPX IF ERROR-CODE 4, 00416000
  413. LR R6,R0 SAVE R0, 00417000
  414. LR R0,R1 SET UP R0 FOR TRKLKPX, 00418000
  415. LR R1,SAVPAM ALSO R1, 00419000
  416. LR SAVSAV,R13 SAVE R13, 00420000
  417. LA R13,TRKLSAVE SET UP SAVE-AREA FOR TRKLKPX, 00421000
  418. BALR R14,R15 GIVE THE TRACK BACK - WE WON'T BE USING IT 00422000
  419. LR R13,SAVSAV RESTORE R13 TOUT SUITE 00423000
  420. LR R0,R6 RESTORE R0, 00424000
  421. SR11 SR R1,R1 CLEAR R1 TO SHOW NO TRACK AVAILABLE 00425000
  422. LA R15,1 ERROR-CODE 1 00426000
  423. B RETURNQ GO RESTORE REGISTERS AND EXIT. 00427000
  424. * 00428000
  425. CANSPILL EQU *-CHKERR ****SHOWS HOW MANY BYTES CAN SPILL OVER OK**** 00429000
  426. EJECT 00430000
  427. * 00431000
  428. * DEFINITIONS 00432000
  429. * 00433000
  430. R0 EQU 0 00434000
  431. R1 EQU 1 00435000
  432. R2 EQU 2 00436000
  433. SAVPAM EQU R2 00437000
  434. QQTBL EQU 3 00438000
  435. R4 EQU 4 00439000
  436. ZERO EQU R4 00440000
  437. R5 EQU 5 00441000
  438. SAVSAV EQU 5 00442000
  439. RET EQU 5 00443000
  440. R6 EQU 6 00444000
  441. XR1 EQU 7 POINTER 00445000
  442. XR2 EQU 8 INCREMENT 00446000
  443. XR3 EQU 9 COMPARAND 00447000
  444. COUNT EQU 10 00448000
  445. R11 EQU 11 00449000
  446. R12 EQU 12 00450000
  447. R13 EQU 13 00451000
  448. R14 EQU 14 00452000
  449. R15 EQU 15 00453000
  450. ADDR EQU R15 00454000
  451. SPACE 1 00454100
  452. T3340 EQU X'07' @V2A2014 00454200
  453. T2314 EQU X'08' @V2A2014 00454300
  454. T3330 EQU X'09' @V2A2014 00454400
  455. * 00455000
  456. EJECT 00456000
  457. NUCON 00457000
  458. ADT 00458000
  459. EJECT 00459000
  460. FVS 00460000
  461. END 00461000