Table of Contents

DMSQRY Source

References

Source Listing

DMSQRY.ASSEMBLE.txt
  1. QRY TITLE 'DMSQRY (CMS) VM/370 - RELEASE 6' 00001000
  2. SPACE 2 00002000
  3. *. 00003000
  4. * MODULE NAME - 00004000
  5. * 00005000
  6. * DMSQRY 00006000
  7. * 00007000
  8. * FUNCTION - 00008000
  9. * 00009000
  10. * QUERY COMMAND. TO DISPLAY AT THE USER'S TERMINAL THE STATUS 00010000
  11. * OF VARIOUS CMS FUNCTIONS AND TABLES. 00011000
  12. * 00012000
  13. * ATTRIBUTES - 00013000
  14. * 00014000
  15. * TRANSIENT, NOT REENTRANT, CALLED VIA SVC 202 00015000
  16. * 00016000
  17. * ENTRY POINTS - 00017000
  18. * 00018000
  19. * 1. DMSQRY, QUERY - QUERY COMMAND 00019000
  20. * 00020000
  21. * ENTRY CONDITIONS - 00021000
  22. * 00022000
  23. * GPR1 = A(PLIST) 00023000
  24. * PLIST = CL8'QUERY' 00024000
  25. * CL8 - FUNCTION 00025000
  26. * CLn - n = 8 * number of argument for cmd HRC101DS 00026290
  27. * CL8 - ( or FENCE HRC101DS 00026580
  28. * CL8 - STACK HRC101DS 00026870
  29. * CL8 - FIFO/LIFO HRC101DS 00027160
  30. * CL8 - FENCE HRC101DS 00027450
  31. * 00028000
  32. * FUNCTIONS = ABBREV, BLIP, DISK MODE|*|MAX|R/W,HRC003DS 00029490
  33. * FILEDEF, IMPCP, IMPEX, INPUT, 00030000
  34. * LDRTBLS, LIBRARY, MACLIB, OUTPUT, PROTECT, 00031000
  35. * RDYMSG, REDTYPE, RELPAGE, SEARCH, 00032000
  36. * SYNONYM SYSTEM|USER|ALL, TXTLIB 00033000
  37. * SYSNAMES, DOSLIB, DOS, DOSPART, OPTION, 00034000
  38. * UPSI, DLBL, DOSLNCNT, CMSLEVEL HRC322DS 00035000
  39. * 00036000
  40. * EXIT CONDITIONS - 00037000
  41. * 00038000
  42. * NORMAL - 00039000
  43. * GPR15 = 0 00040000
  44. * 00041000
  45. * ERROR - 00042000
  46. * GPR15 = 24 : INVALID PARAMETER 00043000
  47. * 24 : NO FUNCTION SPECIFIED 00044000
  48. * 24 : TOO MANY PARAMETERS SPECIFIED 00045000
  49. * 24 : REQUIRED PARAMETER NOT SPECIFIED 00046000
  50. * 24 : INVALID FUNCTION SPECIFIED 00047000
  51. * 00048000
  52. * EXTERNAL REFERENCES - 00049000
  53. * 00050000
  54. * ABDSECT - SYSTEM SYNONYM INFORMATION 00051000
  55. * NUCON - NUCLEUS CONSTANTS AREA 00052000
  56. * EXTSECT - EXTERNAL INTERRUPT INFORMATION 00053000
  57. * CMSCB - FCB INFORMATION 00054000
  58. * ADT - ACTIVE DISK TABLE INFORMATION 00055000
  59. * 00056000
  60. * CALLS TO OTHER ROUTINES - 00057000
  61. * 00058000
  62. * DMSLAD - FIND THE NEXT ACTIVE DISK TABLE 00059000
  63. * DMSCWR - TYPE A MSG ON THE TERMINAL 00060000
  64. * DMSERR - OUTPUT A MSG TO THE TERMINAL 00061000
  65. * Diag83 - Issue CP command HRC322DS 00062000
  66. * 00063000
  67. * TABLES/WORKAREAS - 00064000
  68. * 00065000
  69. * ITRTABLE - STANDARD INPUT TRANSLATE TABLE 00066000
  70. * OTRTABLE - STANDARD OUTPUT TRANSLATE TABLE 00067000
  71. * 00068000
  72. * REGISTER USAGE - 00069000
  73. * 00070000
  74. * GPR0, GPR1 = SETTING UP ENTRY CONDITIONS TO EXTERNAL ROUTINES 00071000
  75. * GPR2 = A(DMSQRY PLIST) 00072000
  76. * GPR5 = BRANCH TAKEN AFTER QUERIED OPTION HAS OUTPUT ITS STATUS 00073000
  77. * GPR4, GPR12 = BASE REGISTERS 00074000
  78. * GPR14 = LINK REGISTER FOR BALR 00075000
  79. * GPR15 = ADDRESS REGISTER FOR BALR 00076000
  80. * GPR3, GPR6, GPR7, GPR8, GPR9, GPR10, GPR11 00077000
  81. * GPR13 = WORK REGS. 00078000
  82. * 00079000
  83. * NOTES - 00080000
  84. * 00081000
  85. * NONE 00082000
  86. * 00083000
  87. * OPERATION - 00084000
  88. * 00085000
  89. * 1. ADVANCE 8 BYTES IN PLIST TO OPTION 00086000
  90. * QUERIED. IF IT IS A FENCE, EXIT. IF IT IS NOT A CMS 00087000
  91. * QUERY, PASS IT UPT TO CP. IF IT IS A CMS QUERY, GO 00088000
  92. * TO THE ROUTINE WHICH WILL FIND OUT THE STATUS OF THE 00089000
  93. * FUNCTION. 00090000
  94. * 00091000
  95. * 2. THE STATUS OF THE QUERIED FUNCTION IS DETERMINED BY 00092000
  96. * THE SETTING OF THE FOLLOWING REFERENCES: 00093000
  97. * 00094000
  98. * ABBREV - 'NOABBREV' FLAG OF OPTFLAGS (IN NUCON. 00095000
  99. * BLIP - 'TIMCHAR', 'TIMCCW' IN EXISECT 00096000
  100. * DOS - 'DOSMODE' FLAG OF DOAFLAGS IN NUCON 00097000
  101. * DOSPART - 'DOSKPART' FIELD IN NUCON 00098000
  102. * FILEDEF - FCB CHAIN 00099000
  103. * DLBL - DOSCB CHAIN 00100000
  104. * IMPCP - 'NOIMPCP' FLAG OF OPTFLAGS IN NUCON 00101000
  105. * IMPEX - 'NOIMPEX' FLAG OF OPTFLAGS IN NUCON 00102000
  106. * LDRTBLS - HIGH ORDER BYTE OF ALDRTBLS IN NUCON 00103000
  107. * MACLIB - AMACLIBL IN NUCON 00104000
  108. * TXTLIB - ATXTLIBS IN NUCON 00105000
  109. * DOSLIB - DOSLIBL IN NUCON 00106000
  110. * RDYMSG - 'NORDYMSG', 'NORDYTIM' FLAGS IN MSGFLAGS 00107000
  111. * IN NUCON 00108000
  112. * REDTYPE - 'REDERRID' FLAG OF MSGFLAGS IN NUCON 00109000
  113. * RELPAGE - 'NOPAGREL' FLAG IN OPTFLAGS IN NUCON 00110000
  114. * SYNONYM - 'NOSTDSYN' FLAG IN OPTFLAGS IN NUCON 00111000
  115. * AND USABRV 00112000
  116. * SEARCH - ACTIVE DISK TABLES 00113000
  117. * SYSNAMES - CURRENT SEGMENT NAMES TABLE 00114000
  118. * OPTION - BYTES 58 AND 59 OF DOS COMM. REGION 00115000
  119. * UPSI - 'UPSI' BYTE IN DOS COMMUNICATION REGION 00116000
  120. * DISK - ACTIVE DISK TABLES 00117000
  121. * INPUT - AINTRTBL IN NUCON 00118000
  122. * OUTPUT - AOUTRTBL IN NUCON 00119000
  123. * PROTECT - 'PRFPOFF' OF PROTFLAG IN NUCON 00120000
  124. * LIBRARY - SEE MACLIB AND TXTLIB OPTIONS 00121000
  125. * DOSLNCNT - INTERROGATE DOS SYSLST LINES/PAGE VALUE 00122000
  126. * 00123000
  127. * 00124000
  128. * 3. OUTPUT THE STATUS. 00125000
  129. * 00126000
  130. * 4. RETURN TO CALLER 00127000
  131. *. 00128000
  132. EJECT 00129000
  133. DMSQRY START 0 ENTER @V305066 00130000
  134. QUERY EQU * @V305066 00131000
  135. ENTRY DMSQRY 00132000
  136. USING *,R12,R4 ADDRESSABILITY FOR EVERYBODY 00133000
  137. LA R4,4095(,R12) SET UP R4 00134000
  138. LA R4,1(,R4) TO CORRECT ADDRESS 00135000
  139. ST R14,SAVE14 SAVE R14 (FOR EVERYBODY) 00136000
  140. USING NUCON,R0 REFERENCE NUCON & CONGEN DSECT 00137000
  141. * 00138000
  142. NI OPTSFLAG,255-(OPTFIFO+OPTSTACK+OPTLIFO) HRC101DS 00138500
  143. LA R2,8(,R1) POINT TO THE QUERY FUNCTION WANTED 00139000
  144. CLI 0(R2),FENCE ANY FUNCTION SPECIFIED HRC101DS 00140020
  145. BE ERROR047 NO, SIGNAL ERROR TO USER HRC101DS 00140040
  146. LA R9,8(,R2) POINT TO WHAT SHOULD BE FENCE HRC101DS 00140060
  147. SPACE , HRC101DS 00140080
  148. QRY100FF EQU * HRC101DS 00140100
  149. CLI 0(R9),FENCE IS THIS THE FENCE ? HRC101DS 00140120
  150. BE QRY100ND YES, ALL DONE HRC101DS 00140140
  151. CLI 0(R9),C'(' BEGIN OF OPTION ? HRC101DS 00140160
  152. BE QRY100OP YES, CHECK THEM OUT HRC101DS 00140180
  153. LA R9,8(,R9) CHECK NEXT TOKEN HRC101DS 00140200
  154. B QRY100FF LOOP AGAIN HRC101DS 00140220
  155. SPACE , HRC101DS 00140240
  156. QRY100OP EQU * HRC101DS 00140260
  157. ST R9,SAVE9 SAVE FOR LATER HRC101DS 00140280
  158. LA R9,8(,R9) CHECK NEXT TOKEN HRC101DS 00140300
  159. SPACE , HRC101DS 00140320
  160. QRY100FO EQU * HRC101DS 00140340
  161. CLC 0(8,R9),=CL8'FIFO' HRC101DS 00140360
  162. BE QRY100FI YES, SET FLAG AND CONTINUE HRC101DS 00140380
  163. CLC 0(8,R9),=CL8'LIFO' HRC101DS 00140400
  164. BE QRY100LI YES, SET FLAG AND CONTINUE HRC101DS 00140420
  165. CLC 0(8,R9),=CL8'STACK' HRC101DS 00140440
  166. BNE ERROR003 HRC101DS 00140460
  167. SPACE , HRC101DS 00140480
  168. QRY100FN EQU * HRC101DS 00140500
  169. TM OPTSFLAG,OPTSTACK HAVE WE BEEN HERE BEFORE? HRC101DS 00140520
  170. BO ERROR070 YES, INDICATE ERROR HRC101DS 00140540
  171. OI OPTSFLAG,OPTSTACK+OPTFIFO HRC101DS 00140560
  172. SPACE , HRC101DS 00140580
  173. QRY100FX EQU * HRC101DS 00140600
  174. LA R9,8(,R9) HRC101DS 00140620
  175. CLI 0(R9),FENCE END OF OPTION HRC101DS 00140640
  176. BE QRY100SF DEFAULT TO FIFO HRC101DS 00140660
  177. CLI 0(R9),C')' END OF OPTION HRC101DS 00140680
  178. BNE QRY100FO NO, CHECK FOR LIFO/FIFO HRC101DS 00140700
  179. CLI 8(R9),FENCE FENCE ? HRC101DS 00140720
  180. BNE ERROR070 ERROR 70 HRC101DS 00140740
  181. SPACE , HRC101DS 00140760
  182. QRY100SF EQU * HRC101DS 00140780
  183. L R9,SAVE9 RESTORE R9 HRC101DS 00140800
  184. MVI 0(R9),FENCE SET NEW FENCE HRC101DS 00140820
  185. B QRY100ND CONTINUE HRC101DS 00140840
  186. SPACE , HRC101DS 00140860
  187. QRY100FI EQU * HRC101DS 00140880
  188. OI OPTSFLAG,OPTSTACK+OPTFIFO HRC101DS 00140900
  189. B QRY100FX HRC101DS 00140920
  190. SPACE , HRC101DS 00140940
  191. QRY100LI EQU * HRC101DS 00140960
  192. OI OPTSFLAG,OPTSTACK+OPTLIFO HRC101DS 00140980
  193. B QRY100FX HRC101DS 00141000
  194. SPACE , HRC101DS 00141020
  195. QRY100ND EQU * HRC101DS 00141040
  196. LA R7,FIRSTCOM POINT TO FIRST COMMAND 00142000
  197. LA R8,12 12 BYTES APIECE, PLEASE 00143000
  198. LA R9,AFTRLAST POINT TO LAST COMMAND 00144000
  199. LA R3,11 BASIC 11 CHAR OUTPUT MSG FOR MOST OPTIONS 00145000
  200. LA R5,SR1515 AFTER TYPE OUT, EXIT 00146000
  201. ST R5,NEXTLIB RESET NEXTLIB JUST IN CASE @V305001 00147000
  202. MVC QSTATUS,QSTATUS-1 INITIALIZE THE STATUS FIELD 00148000
  203. FINDCOM CLC 0(8,R2),0(R7) DOES THE FLAVOR MATCH ? 00149000
  204. BE QRY100 SEE IF ANY EXTRA PARMS. 00150000
  205. BXLE R7,R8,FINDCOM HOPEFULLY FIND THE COMMAND. 00151000
  206. * 00152000
  207. CPFUNC EQU * 00153000
  208. TM OPTFLAGS,NOIMPCP HAS IMPCP BEEN TURNED OFF 00154000
  209. BO ERROR014 YES, DON'T RECOGNIZE FUNCTION 00155000
  210. TM OPTSFLAG,OPTSTACK DO WE STACK THE CP COMMANDS HRC101DS 00155300
  211. BO CPQUERY yes, continue HRC101DS 00155600
  212. LA R15,3 SET RETURN CODE FOR INT TO CALL @VA02653 00156000
  213. * CP 00157000
  214. LNR R15,R15 AND MAKE IT NEG (MAKE BELIEVE @VA02653 00158000
  215. * ITS COULDNOT FIND) 00159000
  216. OI MISFLAGS,NEGITS SET FLAG FOR DMSINT @V305132 00160000
  217. B EXIT @VA02653 00161000
  218. SPACE 2 00163000
  219. QRY100 EQU * SEE IF ANY EXTRA PARMS. SPECIFIED 00164000
  220. LA R9,8(,R2) POINT TO WHAT SHOULD BE FENCE HRC101DS 00165490
  221. CLC CSYNONYM,0(R7) IS THIS THE SYNONYM FUNCTION 00166000
  222. BE QRY110 YES, SEE IF PARM. ENTERED 00167000
  223. CLC CDLBL,0(R7) DLBL LIST REQUEST? @VA05247 00170000
  224. BE 8(,R7) YES, SPECIAL HANDLING @VA05247 00171000
  225. CLC CDISK,0(R7) DISK FUNCTION HRC003DS 00171300
  226. BE 8(,R7) YES, SPECIAL HANDLING HRC003DS 00171600
  227. CLI 0(R9),FENCE IS A FENCE THERE ? HRC101DS 00172590
  228. BNE ERROR070 NO, UNEXPECTED PARAMETER HRC101DS 00173180
  229. B 8(,R7) YES, BRANCH TO ROUTINE FOR EXEC. 00174000
  230. SPACE 00175000
  231. QRY110 EQU * SEE IF POSITIONAL PARAMETER ENTERED 00176000
  232. CLI 0(R9),X'FF' FENCE ? 00177000
  233. BE ERROR005 FUNCTION PARAMETER NOT SPEC. P0705 00178000
  234. LA R9,8(,R9) POINT TO WHAT SHOULD BE FENCE 00179000
  235. CLI 0(R9),X'FF' FENCE ? 00180000
  236. BNE ERROR070 NO, UNEXPECTED PARAMETER 00181000
  237. B 8(,R7) YES, PUT OUT THE STATUS 00182000
  238. EJECT 00183000
  239. FIRSTCOM DS 0F PRECEDES FIRST SET FLAVOR: 00184000
  240. * 00185000
  241. CCMSLEVL DC CL8'CMSLEVEL' CMSLEVEL HRC001DS 00186390
  242. B CMSLEVEL HRC001DS 00186780
  243. CABBREV DC CL8'ABBREV' ABBREV HRC001DS 00187170
  244. B ABBREV HRC001DS 00187560
  245. CABEND DC CL8'ABEND' ABEND HRC009DS 00187660
  246. B ABEND HRC009DS 00187760
  247. CBLIP DC CL8'BLIP' BLIP 00188000
  248. B BLIP 00189000
  249. CDISK DC CL8'DISK' DISK 00190000
  250. B DISK 00191000
  251. CFILEDEF DC CL8'FILEDEF' FILEDEF 00192000
  252. B FILEDEF 00193000
  253. CIMPCP DC CL8'IMPCP' IMPCP 00194000
  254. B IMPCP 00195000
  255. CIMPEX DC CL8'IMPEX' IMPEX 00196000
  256. B IMPEX 00197000
  257. CINPUT DC CL8'INPUT' INPUT 00198000
  258. B INPUT 00199000
  259. CLDRTBLS DC CL8'LDRTBLS' LDRTBLS 00200000
  260. B LDRTBLS 00201000
  261. CLIBRARY DC CL8'LIBRARY' LIBRARY 00202000
  262. B LIBRARY 00203000
  263. CMACLIB DC CL8'MACLIB' MACLIB 00204000
  264. B MACLIB 00205000
  265. COUTPUT DC CL8'OUTPUT' OUTPUT 00206000
  266. B OUTPUT 00207000
  267. CPROTECT DC CL8'PROTECT' PROTECT 00208000
  268. B PROTECT 00209000
  269. CRDYMSG DC CL8'RDYMSG' RDYMSG 00210000
  270. B RDYMSG 00211000
  271. CREDTYPE DC CL8'REDTYPE' REDTYPE 00212000
  272. B REDTYPE 00213000
  273. CRELPAGE DC CL8'RELPAGE' RELPAG 00214000
  274. B RELPAGE 00215000
  275. CSEARCH DC CL8'SEARCH' SEARCH 00216000
  276. B SEARCH 00217000
  277. CSYNONYM DC CL8'SYNONYM' SYNONYM 00218000
  278. B SYNONYM 00219000
  279. CSYSNAME DC CL8'SYSNAMES' SYSNAMES @V305614 00220000
  280. B QRYSYSN @V305614 00221000
  281. CTXTLIB DC CL8'TXTLIB' TXTLIB 00222000
  282. B TXTLIB 00223000
  283. CDOSLIB DC CL8'DOSLIB' DOSLIB @V305001 00224000
  284. B DOSLIB @V305001 00225000
  285. CDOS DC CL8'DOS' DOS @V305001 00226000
  286. B DOS @V305001 00227000
  287. CDOSPART DC CL8'DOSPART' DOSPART @VA04299 00228000
  288. B DOSPART @VA04299 00229000
  289. COPTION DC CL8'OPTION' OPTION @V305001 00230000
  290. B OPTION @V305001 00231000
  291. CLINECT DC CL8'DOSLNCNT' @V505098 00232000
  292. B LINECT @V505098 00233000
  293. CUPSI DC CL8'UPSI' UPSI @V305001 00234000
  294. B UPSIBYTE @V505098 00235000
  295. CDLBL DC CL8'DLBL' DLBL @VA04310 00236000
  296. B DLBL @VA04310 00237000
  297. AFTRLAST EQU *-12 POINTS TO LAST QUERY FUNCTION 00238000
  298. EJECT 00239000
  299. * 00240000
  300. * DISK. IF 'DISK *' , TYPE OUT ALL INFORMATION ON ALL DISKS LOGGED 00241000
  301. * IN. IF 'DISK MAX' , TYPE OUT ALL INFORMATION ON THE R/W DISK HRC003DS 00242190
  302. * LOGGED IN WITH THE MOST SPACE AVAILABLE. IF 'DISK R/W', TYPE HRC003DS 00242380
  303. * OUT ALL INFORMATION ON ALL THE R/W DISKS LOGGED IN. ELSE HRC003DS 00242570
  304. * TYPE OUT ALL INFORMATION ON THE SPECIFIED DISK. HRC003DS 00242760
  305. * 00243000
  306. DISK EQU * 00244000
  307. L R8,AFVS FILE SYSTEM INFORMATION 00245000
  308. USING FVSECT,R8 ... 00246000
  309. * 00247000
  310. SR R3,R3 INDICATE NO SUCCESS YET, 00248000
  311. STC R3,FRSTFLAG SHOW FIRST TIME TRUE HRC003DS 00248500
  312. SH R1,=H'8' BACK OFF 8 BYTES SO MODE WILL BE 24(R1) 00249000
  313. CLI 8(R2),FENCE DISK USER ENTER "QUERY DISK" ? HRC101DS 00249140
  314. BE DISK20 YES, TREAT AS "QUERY DISK *" HRC003DS 00249200
  315. CLC STRRW,8(R2) WAS "Q DISK R/W" REQUESTED ? HRC003DS 00249300
  316. BE DISK19 YES, CONTINUE HRC003DS 00249400
  317. CLC STRMAX,8(R2) WAS "Q DISK MAX" REQUESTED ? HRC003DS 00249500
  318. BE DISK1 YES, CONTINUE HRC003DS 00249600
  319. CLC =C'* ',8(R2) WAS '*' SPECIFIED HRC003DS 00249700
  320. BE DISK20 YES, PUT STATUS OF ALL DISKS HRC003DS 00249800
  321. L R15,VCADTLKP LOOK UP DISK, HRC003DS 00249900
  322. LA R7,DSKTBL POINT TO BEGINNING OF SYM. NAMES 00250000
  323. LA R8,2 CHECK 2 CHARACTERS 00251000
  324. LA R9,ENDTBL POINT TO END OF TABLE 00252000
  325. VALMODE EQU * SEE IF VALID MODE LETTER ENTERED 00253000
  326. CLC 0(2,R7),8(R2) IS THIS THE MODE ? 00254000
  327. BE DISK10 YES, PUT OUT IT'S STATUS 00255000
  328. BXLE R7,R8,VALMODE NO, CHECK THE NEXT ONE 00256000
  329. B ERROR026 DON'T KNOW MODE 00259000
  330. DISK1 EQU * PUT OUT STATUS OF DISK HRC003DS 00260390
  331. LA R1,STRQMRK-24 HRC003DS 00260780
  332. L R15,VCADTLKW SEARCH R/W DISK HRC003DS 00261170
  333. DISK10 EQU * PUT OUT STATUS OF DISK HRC003DS 00261560
  334. BALR R14,R15 ... 00262000
  335. BNZ NOTFOUND BNZ IF NOT FOUND. 00263000
  336. BAL R14,PTSUB IF FOUND BY ACTLKP, THAT'S IT. 00264000
  337. B SR1515 RESTORE R14, AND EXIT. 00265000
  338. DISK19 EQU * PUT OUT STATUS OF ALL R/W DISKS HRC003DS 00266190
  339. OI FRSTFLAG,QRWDSK SEARCH ONLY R/W DISKS HRC003DS 00266380
  340. DISK20 EQU * PUT OUT STATUS OF ALL DISKS HRC003DS 00266570
  341. SR R0,R0 START WITH 0 THE FIRST TIME 00267000
  342. LOOKUP LR R1,R0 INITIALIZE R1 AND 00268000
  343. L R15,VCADTNXT LOOK ONE UP, @VM03093 00269000
  344. BALR R14,R15 ... 00270000
  345. BNZ GIVMSG1 NONE LEFT, CONTINUE HRC003DS 00271290
  346. * BCR 7,R5 NONE LEFT, RETURN TO CALLER HRC003DS 00271580
  347. LR R0,R1 REMEMBER R1 FOR NEXT TIME, 00272000
  348. USING ADTSECT,R1 REFERENCE ACTIVE-DISK-TABLE, 00273000
  349. TM ADTFLG1,ADTFRO+ADTFRW ANYTHING THERE AT ALL ? 00274000
  350. BNZ GIVMSG YES..GO SCAN ADT @V201101 00275000
  351. TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00276000
  352. BZ LOOKUP NO..KEEP LOOKING @V201101 00277000
  353. GIVMSG BAL R14,PTSUB GIVE MESSAGE IF CONDITIONS RIGHT 00278000
  354. B LOOKUP AND KEEP LOOKING. 00279000
  355. GIVMSG1 EQU * HRC003DS 00279200
  356. TM FRSTFLAG,FRSTTIME DID WE TYPE ANY ?? HRC003DS 00279400
  357. BOR R5 YES, RETURN TO CALLER HRC003DS 00279600
  358. B ERROR006 HRC003DS 00279800
  359. DROP R1 00280000
  360. EJECT 00281000
  361. * 00282000
  362. * SEARCH. DISPLAY THE SEARCH ORDER CURRENTLY IN EFFECT 00283000
  363. * 00284000
  364. SEARCH EQU * 00285000
  365. USING ADTSECT,R1 00286000
  366. SR R0,R0 ZERO R0 00287000
  367. LOOKUP2 EQU * 00288000
  368. LR R1,R0 FIND FIRST OR NEXT DISK ACCESSED 00289000
  369. L R15,VCADTNXT TO GET ADT INFORMATION @VM03093 00290000
  370. BALR R14,R15 GET FIRST (OR NEXT) DISK IN ORDER 00291000
  371. BCR 7,R5 IF NO MORE, RETURN TO CALLER 00292000
  372. LR R0,R1 SAVE FOR NEXT ADTLOOKUP 00293000
  373. TM ADTFLG1,ADTFRO+ADTFRW ANYTHING THERE ? 00294000
  374. BNZ PSHORT YES..START WITH DEVICE ADDR @V201101 00295000
  375. TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00296000
  376. BZ LOOKUP2 NO, KEEP LOOKING @V201101 00297000
  377. PSHORT L R3,ADTDTA REFERENCE DEVICE-ADDRESS, 00298000
  378. UNPK DECDEC(5),DTAD(3,R3) CONVERT TO HEX 00299000
  379. TR DECDEC(4),HEXTBL-C'0' ... 00300000
  380. MVC SHORT1(3),DECDEC+1 STORE JS 00301000
  381. MVC SHORTMSG(6),ADTID MOVE DISK-LABEL TO MESSAGE JS 00302000
  382. MVC SHORT2(1),ADTM MODE-LETTER TO TYPEOUT 00303000
  383. MVC SHORT2+1(2),SHORT3 NEXT TWO CHARS. DEFAULT TO BLANK 00304000
  384. MVI SHORTCNT,SHORTRO SET FOR LENGTH OF WHOLE MESSAGE 00305000
  385. MVC SHORT3+2(L'RO),RO MOVE'R/O' TO MSG 00306000
  386. CLI ADTMX,C' ' ANY EXTENSION-MODE-LETTER THERE ? 00307000
  387. BNE PSHORT2 TRF IF YES. 00308000
  388. TM ADTFLG1,ADTFRO IF NOT, IS DISK READ-ONLY ? 00309000
  389. BO PSHORT1 TYPE OUT THE MESSAGE 00310000
  390. MVC SHORT3+2(L'RW),RW SET 'R/W' IN MSG 00311000
  391. PSHORT1 TM ADTFLG2,ADTFROS IS IT OS/DOS DISK ? @V305101 00312000
  392. BZ PSHORT1B NO, TYPE OUT SEARCH MESSAGE @V305101 00313000
  393. MVI SHORTCNT,SHORTOS SET NEW MESSAGE LENGTH @V305101 00314000
  394. MVC OSMSG+3(L'OSL),OSL INITIALIZE AS O/S DISK @V305101 00315000
  395. MVC SHORT3+2(L'RO),RO SET 'R/O' IN MESSAGE @V305101 00316000
  396. TM ADTFLG2,ADTFDOS IS IT DOS DISK ? @V305101 00317000
  397. BZ PSHORT1A NO, CHECK IF R/W @V305101 00318000
  398. MVC OSMSG+3(L'DOSL),DOSL SET DOS DISK LITERAL @V305101 00319000
  399. PSHORT1A TM ADTFLG3,ADTFRWOS IS DOS/OS DISK R/W ? @V305101 00320000
  400. BZ PSHORT1B NO, TYPE OUT THE MESSAGE @V305101 00321000
  401. MVC SHORT3+2(L'RW),RW SET 'R/W' IN MESSAGE @V305101 00322000
  402. SPACE , HRC101DS 00323190
  403. PSHORT1B EQU * HRC101DS 00323380
  404. LA R1,SHORTMSG GIVE SHORT 'Q SEARCH' MSG HRC101DS 00323570
  405. SR R3,R3 CLEAR R3 HRC101DS 00323760
  406. IC R3,SHORTCNT GET LENGTH HRC101DS 00323950
  407. LR R10,R5 SAVE R5 ACROSS CALL HRC101DS 00324140
  408. BAL R5,TYPEOUT SEND OUT MESSAGE HRC101DS 00324330
  409. LR R5,R10 RESTORE R5 HRC101DS 00324520
  410. B LOOKUP2 AND GO LOOK UP MORE DISKS. 00325000
  411. * 00326000
  412. PSHORT2 CLC ADTM(1),ADTMX IS DISK EXTENSION OF ITSELF ? 00327000
  413. BE PSHORT1 TRF IF YES. 00328000
  414. MVI SHORT2+1,C'/' PLACE EXTENSION MARKER IN MSG 00329000
  415. MVC SHORT2+2(1),ADTMX FOLLOWED BY EXTENSION-MODE-LETTER 00330000
  416. B PSHORT1 AND GO TYPE THE SHORT-MESSAGE. 00331000
  417. * 00332000
  418. DROP R1 00333000
  419. EJECT 00334000
  420. * SUBROUTINE TO FILL IN INFORMATION IN 'PT-MESSAGE' 00335000
  421. * R1 = ADDRESS OF APPROPRIATE ACTIVE-DISK-TABLE 00336000
  422. * R14 = RETURN-REGISTER 00337000
  423. * R9 THRU R11 AND R15 MAY BE USED FOR 'SCRATCH' 00338000
  424. * 00339000
  425. PTSUB LR R6,R1 ACCESS ACTIVE-DISK-TABLE INFO., 00340000
  426. USING ADTSECT,R6 ... 00341000
  427. TM FRSTFLAG,QRWDSK R/W WANTED ? HRC003DS 00342390
  428. BZ PTSUB0 HRC003DS 00342780
  429. TM ADTFLG1,ADTFRO R/O DISK ? HRC003DS 00343170
  430. BOR R14 YES, RETURN TO CALLER HRC003DS 00343560
  431. TM ADTFLG2,ADTFROS+ADTFDOS OS TO DOS DISK? HRC003DS 00343950
  432. BNZR R14 YES, RETURN TO CALLER HRC003DS 00344340
  433. PTSUB0 EQU * HRC003DS 00344730
  434. L R7,ADTCYL GET NUMBER OF CYLINDERS, HRC003DS 00345120
  435. LTR R7,R7 MAKE SURE IT IS NOT ZERO HRC003DS 00345510
  436. BNP NOTFOUND HRC003DS 00345900
  437. TM FRSTFLAG,FRSTTIME IS THIS FIRST TIME HERE? HRC003DS 00346290
  438. BO PTSUB1 BR IF NOT FIRST. HRC003DS 00346680
  439. LA R1,DTITLE GIVE TYPEOUT, HRC101DS 00347160
  440. LA R3,L'DTITLE LENGTH HRC101DS 00347250
  441. LR R10,R5 SAVE ACROSS CALL HRC101DS 00347340
  442. BAL R5,TYPEOUT HRC101DS 00347430
  443. LR R5,R10 SAVE ACROSS CALL HRC101DS 00347520
  444. OI FRSTFLAG,FRSTTIME SHOW THAT WE HAVE BEEN HERE HRC003DS 00347850
  445. PTSUB1 EQU * HRC003DS 00348240
  446. MVI PTMSG,BLANK HRC003DS 00348630
  447. MVC PTMSG+1(LPTMSG-1),PTMSG CLEAR LINE HRC003DS 00349020
  448. MVC PTLABEL,ADTID VOLID HRC003DS 00349410
  449. L R10,ADTDTA POINT TO ACTUAL-DEVICE-ADDRESS, HRC003DS 00349800
  450. UNPK DECDEC(5),DTAD(3,R10) CONVERT P-DISK OR T-DISKHRC003DS 00350190
  451. TR DECDEC(4),HEXTBL-C'0' TO PRINTABLE HEX HRC003DS 00350580
  452. MVC PTUNIT(3),DECDEC+1 AND STORE IN THE MESSAGEHRC003DS 00350970
  453. MVC PTMODE,ADTM MOVE MODE TO MESSAGE, HRC003DS 00351360
  454. CLI ADTMX,BLANK ANY EXTENSION HRC003DS 00351750
  455. BE PTSUB2 NO, CONTINUE HRC003DS 00352140
  456. MVI PTSLASH,C'/' ELSE, PUT SEPERATOR HRC003DS 00352530
  457. MVC PTMODEX,ADTMX AND EXTENSION MODE IN MESSAGE HRC003DS 00352920
  458. PTSUB2 EQU * HRC003DS 00353310
  459. MVC PTTYPE,=C'3330' MOVE CHARACTERS TO MESSAGE HRC003DS 00353700
  460. CLI DTADT(R10),T3330 IS IT A 3330 ? @V304498 00357000
  461. BE OK1 CONTINUE HRC003DS 00358790
  462. MVC PTTYPE,=C'3350' MOVE CHARACTERS TO MESSAGE HRC003DS 00359580
  463. CLI DTADT(R10),T3350 3350 ? HRC003DS 00360370
  464. BE OK1 CONTINUE HRC003DS 00361160
  465. MVC PTTYPE,=C'3380' MOVE CHARACTERS TO MESSAGE HRC003DS 00361950
  466. CLI DTADT(R10),T3380 3380 ? HRC003DS 00362740
  467. BE OK1 CONTINUE HRC003DS 00363530
  468. MVC PTTYPE,=C'3340' MOVE CHARACTERS TO MESSAGE HRC003DS 00364320
  469. CLI DTADT(R10),T3340 3340 ? @V304498 00366000
  470. BE OK1 CONTINUE HRC003DS 00368990
  471. CLI DTADT(R10),T2314 IS DISK A 2314 ? @V304498 00371000
  472. BNE NOTFOUND NO, DISK NOT LOGGED IN @V304498 00372000
  473. MVC PTTYPE,=C'2314' MOVE CHARACTERS TO MESSAGE HRC003DS 00373190
  474. OK1 EQU * HRC003DS 00373380
  475. L R7,ADTCYL GET NUMBER OF CYLINDERS, HRC003DS 00373570
  476. CVD R7,DEC NUMCYLP OR NUMCYLT TO DECIMAL HRC003DS 00373760
  477. MVC PTCYL,=X'402020202120' HRC003DS 00373950
  478. ED PTCYL,DEC+5 HRC003DS 00374140
  479. MVC PTSTAT,=C'R/W' FILL IN MESSAGE HRC003DS 00374330
  480. TM ADTFLG1,ADTFRW IS IT READ-WRITE ? HRC003DS 00374520
  481. BO OK2 BO IF YES (TYPEOUT OK AS IS). 00375000
  482. MVI PTSTAT+2,C'O' IF NOT MAKE IT "R/O" THEN HRC003DS 00376490
  483. OK2 TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00377000
  484. BO CLRZEROS YES..SKIP NEXT @V201101 00378000
  485. LM R9,R11,ADTNUM R9=ADTNUM,R10=ADTUSED,R11=ADTLEFT 00387000
  486. CVD R9,DEC NUMTRKS TO DECIMAL HRC003DS 00389990
  487. MVC PTBLKTOT,=X'402020202020202020202120' HRC003DS 00391980
  488. ED PTBLKTOT,DEC+2 MAKE IT DISPLAYABLE HRC003DS 00393970
  489. LTR R11,R11 CHECK 'NUMBER LEFT' 00396000
  490. BP R11OK MUST BE OK IF > 0 (HOPEFULLY) 00397000
  491. LR R11,R9 IF NOT, COMPUTE IT FROM SCRATCH 00398000
  492. SR R11,R10 NOW WE HAVE IT. 00399000
  493. R11OK CVD R11,DEC CONVERT TO DECIMAL 00400000
  494. MVC PTBLKFRE,=X'402020202020202020202120' HRC003DS 00401990
  495. ED PTBLKFRE,DEC+2 MAKE IT DISPLAYABLE HRC003DS 00402980
  496. * NOW COMPUTE PERCENTAGE OF TRACKS IN USE 00404000
  497. LR R11,R10 NUMBER TRACKS IN USE INTO R11 FOR 'M' 00405000
  498. M R10,=F'1000' MULTIPLY R11 BY 1000 FOR ROUNDED, 00406000
  499. DR R10,R9 DIVIDE NO. TRACKS BY TOTAL NO. 00407000
  500. A R11,=F'5' ADD 5 TO ROUND QUOTIENT 00408000
  501. C R11,=F'1000' MAKE SURE 99. OR LESS 00409000
  502. BL OK99 OK IF NOT MORE THAN 99 00410000
  503. L R11,=F'990' MAKE IT 99. IF WAS MORE 00411000
  504. OK99 CVD R11,DEC CONVERT TO DECIMAL 00412000
  505. MVC PTPCTUSD,=X'F02120' HRC003DS 00413490
  506. ED PTPCTUSD,DEC+6 HRC003DS 00413980
  507. MVI PTPCTUSD,C'-' HRC003DS 00414470
  508. L R10,ADTUSED HRC003DS 00414960
  509. CVD R10,DEC NUMBER OF RECORDS IN USE... HRC003DS 00415450
  510. MVC PTBLKUSD,=X'402020202020202020202120' HRC003DS 00415940
  511. ED PTBLKUSD,DEC+2 MAKE IT DISPLAYABLE HRC003DS 00416430
  512. L R7,ADTFSTC NUMBER OF FILES, HRC003DS 00416920
  513. CVD R7,DEC HRC003DS 00417410
  514. MVC PTFILES,=X'402020202020202020202120' HRC003DS 00417900
  515. ED PTFILES,DEC+2 READABLE HRC003DS 00418390
  516. MVC PTBLKS,=C' 800' CDF DISK SIZE HRC003DS 00418880
  517. CLRZEROS EQU * HRC003DS 00419370
  518. TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00420000
  519. BO OSLINE YES..DON'T CHECK ANYMORE @V201101 00421000
  520. LINEDONE EQU * HRC003DS 00430990
  521. LA R1,PTMSG MESSAGE TO PRINT HRC101DS 00441490
  522. LA R3,LPTMSG MESSAGE LENGTH HRC101DS 00441980
  523. LR R10,R5 SAVE ACROSS CALL HRC101DS 00442470
  524. BAL R5,TYPEOUT GIVE TYPEOUT, HRC101DS 00442960
  525. LR R5,R10 RESTORE IT NOW HRC101DS 00443450
  526. BR R14 AND RETURN TO MAIN PART. 00444000
  527. * 00445000
  528. SPACE 00453000
  529. OSLINE TM ADTFLG3,ADTFRWOS IS DISK R/W ? @V305101 00454000
  530. BZ OSLINE2 NO, COMPRSS DISK LINE @V305101 00455000
  531. MVI PTSTAT+2,C'W' SET MSG FOR R/W DISK HRC003DS 00456990
  532. OSLINE2 EQU * HRC003DS 00457980
  533. MVC PTFILES+5(2),=C'OS' HRC003DS 00458970
  534. TM ADTFLG2,ADTFDOS IS IT DOS DISK ? @V305101 00463000
  535. BZ LINEDONE NO, RETURN HRC003DS 00464990
  536. MVI PTFILES+4,C'D' SET AS DOS DISK HRC003DS 00465980
  537. B LINEDONE RETURN HRC003DS 00466970
  538. EJECT , HRC009DS 00467050
  539. * HRC009DS 00467130
  540. * ABEND. TYPE OUT THE COMMAND NAME TO EXECUTE UPON ABEND. HRC009DS 00467210
  541. * HRC009DS 00467290
  542. ABEND EQU * HRC009DS 00467370
  543. MVC QOPT,CABEND OPTION QUERIED HRC009DS 00467450
  544. L R7,ABNCOMND R6=A(USER ABEND COMMAND) HRC009DS 00467530
  545. LTR R7,R7 DOES ONE EXIST ? HRC009DS 00467610
  546. BNZ ABEND1 YES, FIND OUT WHAT IT IS HRC009DS 00467690
  547. MVC QSTATUS(4),NONE INDICATE NONE SET HRC009DS 00467770
  548. LA R3,4(,R3) 4 CHARACTERS ADDED TO TYPEOUT LINHRC009DS 00467850
  549. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00467960
  550. ABEND1 EQU * HRC009DS 00468010
  551. SR R6,R6 CLEAR FOR LENGTH HRC009DS 00468090
  552. IC R6,0(R7) GET LENGTH OF ABEND COMMAND HRC009DS 00468170
  553. BCTR R6,0 LESS ONE FOR EXECUTE HRC009DS 00468250
  554. EX R6,MOVABN COMMAND LINE TO BUFFER HRC009DS 00468330
  555. LA R3,1(R3,R6) ADD LEN OF STD QUERY RESPONSE HRC009DS 00468410
  556. STH R3,QMSGL HRC009DS 00468490
  557. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00468640
  558. SPACE , HRC009DS 00468730
  559. MOVABN MVC QSTATUS(0),1(R7) ABEND COMMAND TO BUFFER HRC009DS 00468810
  560. EJECT 00469000
  561. * 00470000
  562. * ABBREV. IF ABBREV IS ON TYPE OUT THE ABBREVIATIONS IN EFFECT. 00471000
  563. * 00472000
  564. ABBREV EQU * 00473000
  565. MVC QOPT,CABBREV OPTION QUERIED 00474000
  566. TM OPTFLAGS,NOABBREV ABBREV=OFF? 00475000
  567. BO OPTOFF YES, ABBREV=OFF 00476000
  568. B OPTON NO, ABBREV=ON 00477000
  569. SPACE 2 00478000
  570. * 00479000
  571. * BLIP. IF BLIP=ON, TYPE OUT THE BLIP CHARACTER. 00480000
  572. * 00481000
  573. BLIP EQU * 00482000
  574. L R9,AEXTSECT A(INTERRUPT INFORMATION) 00483000
  575. USING EXTSECT,R9 00484000
  576. MVC QOPT,CBLIP OPTION QUERIED 00485000
  577. CLI TIMCHAR,X'00' IS BLIP OFF? 00486000
  578. BE OPTOFF YES, MESSAGE: BLIP=OFF 00487000
  579. SR R6,R6 ZERO R6 00488000
  580. IC R6,TIMCCW+7 R6=L'(BLIP CHARACTER) 00489000
  581. AR R3,R6 ADD THE NUMBER OF BLIP CHARACTERS 00490000
  582. BCTR R6,0 DECREMENT LENGTH BY 1 FOR MVC INST. 00491000
  583. EX R6,MVC MOVE THE BLIP CHARACTER INTO THE MESSAGE 00492000
  584. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00493490
  585. EJECT 00494000
  586. * 00495000
  587. * UPSI. DISPLAY THE USER DEFINED UPSI BYTE IN THE COMM. REGION 00496000
  588. * 00497000
  589. SPACE 1 00498000
  590. UPSIBYTE TM DOSFLAGS,DOSMODE CMS/DOS MODE ACTIVE ? @V505098 00499000
  591. BZ ERROR099 NO, ERROR @V305001 00500000
  592. MVC QOPT,CUPSI SET FUNCTION NAME @V305001 00501000
  593. SR R10,R10 CLEAR WORK @V305001 00502000
  594. L R1,ASYSREF GET COMM. REGION ADDR. @V305001 00503000
  595. SR R6,R6 CLEAR @V305001 00504000
  596. IC R6,23(R1) GET UPSI BYTE @V305001 00505000
  597. LA R7,ARGLEN LENGTH OF ARGUMENT @V305066 00506000
  598. UPSILUP LA R8,QSTATUS-1 POINT TO BUFFER @V305001 00507000
  599. STC R6,DEC SAVE BYTE IN WORK @V305001 00508000
  600. NI DEC,HEX01 ISOLATE PROPER BIT @V305066 00509000
  601. IC R10,DEC GET UPDATED VALUE @V305001 00510000
  602. CVD R10,DEC CONVERT TO DECIMAL @V305001 00511000
  603. AR R8,R7 POINT TO PROPER PLACE @V305001 00512000
  604. UNPK 0(1,R8),DEC UNPACK VALUE TO BUFFER @V305001 00513000
  605. OI 0(R8),ZONE SET DIGIT ZONE @V305066 00514000
  606. SRL R6,1 UPDATE UPSI BYTE @V305001 00515000
  607. BCT R7,UPSILUP LOOP 'TILL UPSI DONE @V305001 00516000
  608. LA R3,8(,R3) UPDATE BUFFER LENGTH @V305001 00517000
  609. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00518490
  610. EJECT 00519000
  611. * 00520000
  612. * OPTION. DISPLAY THE CMS/DOS NON-STD. OPTIONS IN COMM. REGION 00521000
  613. * 00522000
  614. SPACE 1 00523000
  615. OPTION TM DOSFLAGS,DOSMODE CMS/DOS MODE ACTIVE ? @V305001 00524000
  616. BZ ERROR099 NO, ERROR @V305001 00525000
  617. MVC QOPT,COPTION SET FUNCTION NAME @V305001 00526000
  618. SR R10,R10 CLEAR WORK @V305001 00527000
  619. L R1,ASYSREF GET COMM. REGION ADDRESS @V305001 00528000
  620. LA R6,OPTTAB POINT TO OPTIONS TABLE @V305001 00529000
  621. LA R7,LOPTTAB GET TABLE LENGTH @V305001 00530000
  622. LA R8,QSTATUS POINT TO OUTPUT BUFFER @V305001 00531000
  623. OPTLUP MVC 0(2,R8),=C'NO' INITIALIZE TO 'NO' @V305001 00532000
  624. IC R10,0(R6) GET MASK TO TEST OPTION BYTE @V305001 00533000
  625. EX R10,EXTM SEE IF OPTION 'ON' @V305001 00534000
  626. BO OPTYES BRANCH IF OPTION ACTIVE @V305001 00535000
  627. LA R3,2(,R3) INCLUDE 'NO' IN LENGTH @V305001 00536000
  628. LA R8,2(,R8) BUMP PAST 'NO' IN BUFFER @V305001 00537000
  629. OPTYES MVC 0(6,R8),2(R6) MOVE OPTION TO BUFFER @V305001 00538000
  630. IC R10,1(R6) GET OPTION LENGTH @V305001 00539000
  631. LA R3,0(R10,R3) COMPUTE LAST LENGTH @V305001 00540000
  632. LA R8,0(R10,R8) BUMP TO NEXT POSITION @V305001 00541000
  633. LA R6,8(,R6) BUMP TO NEXT OPTION @V305001 00542000
  634. BCT R7,OPTLUP KEEP LOOKING... @V305001 00543000
  635. MVC 0(4,R8),=CL4'48C' SET CHARSET 48 @V305001 00544000
  636. TM 58(R1),CHAR48C 48C SPECIFIED ? @V305066 00545000
  637. BO OPTLAST YES, CHECK LAST OPTION @V305001 00546000
  638. MVC 0(4,R8),=CL4'60C' SET CHARSET 60 @V305001 00547000
  639. OPTLAST LA R3,4(,R3) LAST BUFFER LENGTH @V305001 00548000
  640. LA R8,4(,R8) BUMP TO NEXT POSITION @V305001 00549000
  641. MVC 0(2,R8),=C'NO' INITIALIZE BUFFER @V305001 00550000
  642. TM 59(R1),DUMP DUMP OPTION IN EFFECT ? @V305066 00551000
  643. BO OPTDONE YES, BRANCH @V305001 00552000
  644. LA R8,2(,R8) BUMP PAST 'NO' @V305001 00553000
  645. OPTDONE MVC 0(5,R8),0(R6) MOVE OPTION TO BUFFER @V305001 00554000
  646. LA R3,8(,R3) FINAL LENGTH @V305001 00555000
  647. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00556490
  648. SPACE 1 00557000
  649. EXTM TM 58(R1),ZERO EXECUTED 'TM' @V305066 00558000
  650. * 00559000
  651. OPTTAB EQU * @V305001 00560000
  652. DC X'80',X'05',CL6'DECK' @V305001 00561000
  653. DC X'40',X'05',CL6'LIST' @V305001 00562000
  654. DC X'20',X'06',CL6'LISTX' @V305001 00563000
  655. DC X'10',X'04',CL6'SYM' @V305001 00564000
  656. DC X'08',X'05',CL6'XREF' @V305001 00565000
  657. DC X'04',X'05',CL6'ERRS' @V305001 00566000
  658. LOPTTAB EQU (*-OPTTAB)/8 @V305001 00567000
  659. DC CL5'DUMP' @V305001 00568000
  660. DS 0H @V305001 00569000
  661. EJECT 00570000
  662. * 00571000
  663. * FILEDEF. INDICATE USER FILEDEF'S IN EFFECT. 00572000
  664. * 00573000
  665. FILEDEF EQU * 00574000
  666. LH R8,FCBNUM GET COUNT OF ENTRIES 00575000
  667. LA R10,SEVEN LENGTH OF 'DLBL' @VA04310 00576000
  668. LTR R8,R8 00577000
  669. BC 8,FLDFMSG IF CONDITION=0, TYPEOUT MESSAGE 00578000
  670. L R6,FCBFIRST GET PTR TO 1ST ENTRY 00579000
  671. USING FCBSECT,R6 00580000
  672. LIST1 MVC LISTMES(8),FCBDD PUT DDNAME INTO MESSAGE 00581000
  673. SR R10,R10 ZERO R10 FOR SUBSEQUENT TABLE LOOKUP 00582000
  674. IC R10,FCBDEV GET THE DEVICE 00583000
  675. AR R10,R10 DOUBLE THE COUNT 00584000
  676. LA R7,DUMMY ACCESS THE FIRST DEVICE 00585000
  677. AR R7,R10 POINT TO THE SPECIFIED DEVICE 00586000
  678. MVC LISTMES+9(8),0(R7) MOVE DEV NAME TO MSG 00587000
  679. CLC LISTMES+9(8),TAP IS IT A TAPE DEVICE. 00588000
  680. BNE LIST2 00589000
  681. MVC LISTMES+12(1),FCBTAPID+3 PUT TAP NUMBER INTO MSG 00590000
  682. * CMSTYPE '8 BLANKS' 00591000
  683. LIST2 EQU * 00592000
  684. CLC LISTMES+9(8),DSK IS IT DISK ? 00593000
  685. BNE LIST3 NO 00594000
  686. MVC LISTMES+18(8),FCBDSNAM MOVE IN DSNAME 00595000
  687. MVC LISTMES+27(8),FCBDSTYP MOVE IN DSTYPE 00596000
  688. LA R3,(L'LISTMES+L'LISTDSK) SET UP LENGTH HRC101DS 00597290
  689. SPACE , HRC101DS 00597580
  690. LIST3 EQU * HRC101DS 00597870
  691. LA R1,LISTMES ADDRESS OF DESCRIPTION HRC101DS 00598160
  692. LR R10,R5 SAVE R5 HRC101DS 00598450
  693. BAL R5,TYPEOUT TYPE OUT MESSAGE HRC101DS 00598740
  694. LR R5,R10 restore register 5 HRC324DS 00599030
  695. L R6,0(,R6) GET PTR TO NEXT ENTRY 00600000
  696. LA R3,L'LISTMES RESTORE DEFAULT LENGTH HRC101DS 00601190
  697. MVI LISTMES,C' ' BLANK OUT FIRST CHAR HRC101DS 00601380
  698. MVC LISTMES+1((L'LISTMES)-1),LISTMES CLEAR BUFFER HRC101DS 00601570
  699. BCT R8,LIST1 CONTINUE FOR ALL ENTRIES 00602000
  700. BR R5 ANY MORE QUERY REQUESTS ? 00603000
  701. SPACE 2 00604000
  702. * 00605000
  703. * IMPCP. INDICATE WHETHER IMPCP=ON|OFF 00606000
  704. * 00607000
  705. IMPCP EQU * 00608000
  706. MVC QOPT,CIMPCP OPTION QUERIED 00609000
  707. TM OPTFLAGS,NOIMPCP IMPLIED CP OFF? 00610000
  708. BO OPTOFF YES, IMPCP=OFF 00611000
  709. B OPTON NO, IMPCP=ON 00612000
  710. SPACE 2 00613000
  711. * 00614000
  712. * IMPEX. INDICATE WHETHER IMPEX=ON|OFF 00615000
  713. * 00616000
  714. IMPEX EQU * 00617000
  715. MVC QOPT,CIMPEX OPTION QUERIED 00618000
  716. TM OPTFLAGS,NOIMPEX IMPLIED EXEC OFF? 00619000
  717. BO OPTOFF YES, IMPEX=OFF 00620000
  718. B OPTON NO, IMPEX=ON 00621000
  719. EJECT 00622000
  720. * 00623000
  721. * INPUT. DISPLAY THE USER DEFINED INPUT TRANSLATE TABLE. 00624000
  722. * 00625000
  723. INPUT EQU * 00626000
  724. L R6,AINTRTBL R6=A(USER DEFINED INPUT TRANSLATE TABLE) 00627000
  725. LTR R6,R6 DOES ONE EXIST ? 00628000
  726. BNP INPMSG NO, OUTPUT A MESSAGE 00629000
  727. LA R6,256(,R6) POINT TO 1 FOR 1 TABLE @VA05384 00630000
  728. LA R13,CONVERT0 TRANSFER HERE AFTER OUTPUTTING MESSAGE 00631000
  729. MVC QOPT,CINPUT MOVE NAME OF OPTION QUERIED TO OUTPUT MSG 00632000
  730. LA R2,QSTATUS+2 PLACE FOR CHAR. TRANSLATED TO 00633000
  731. LA R3,15 15 CHARACTERS TO BE TYPE OUT EACH TIME 00634000
  732. STH R3,QMSGL STORE THE LENGTH OF THE MESSAGE 00635000
  733. LA R8,OTRTABLE COMPARE USER - STANDARD TRANSLATE@VA05384 00636000
  734. LA R7,256 LENGTH OF TRANSLATE TABLE 00637000
  735. LA R9,256 LENGTH OF STANDARD TRANSLATE TABLE 00638000
  736. CONVERT0 EQU * COMPARE EACH CHARACTER IN THE TRANSLATE T 00639000
  737. CLCL R6,R8 FIND THE FIRST NON MATCHING CHARACTER 00640000
  738. LTR R7,R7 AT END OF TABLE ? 00641000
  739. BZ SR1515 YES, RETURN TO CALLER 00642000
  740. LH R10,=H'256' DETERMINE PLACE OF NON-MATCHING CHAR. 00643000
  741. SR R10,R7 NOW IN R10 00644000
  742. STC R10,QSTATUS PUT IN OUTPUT MESSAGE 00645000
  743. IC R10,0(,R6) GET THE CHARACTER USED IN THE TRANSLATION 00646000
  744. CONV EQU * 00647000
  745. LA R3,2 CONVERT TO PRINTABLE HEX 00648000
  746. SRDL R10,8 PUT IN THE HIGH ORDER END OF R11 00649000
  747. CONVERT1 EQU * CONVERT 4 BITS TO PRINTABLE HEX 00650000
  748. SLDL R10,4 SLIDE THEM OVER TO LOW END OF R10 00651000
  749. CH R10,=H'9' IS THE CHARACTER A - F 00652000
  750. BNH CONVERT2 NO, IT'S 1 - 9 00653000
  751. SH R10,=H'9' A - F = 1 - 6 RESPECTIVELY 00654000
  752. O R10,PHEX2 OR IN THE UPPER 4 BITS FOR PRINTING 00655000
  753. B CONVERT4 STORE IN THE OUTPUT MESSAGE 00656000
  754. CONVERT2 EQU * CONVERT 1 - 9 TO PRINTABLE HEX 00657000
  755. O R10,PHEX1 OR IN THE UPPER 4 BITS 00658000
  756. CONVERT4 EQU * PUT THE CHARACTER IN THE OUTPUT MESSAGE 00659000
  757. STC R10,0(,R2) AS SPECIFIED BY R2 00660000
  758. LA R2,1(,R2) INCREMENT R2 FOR NEXT HEX CHARACTER 00661000
  759. SR R10,R10 ZERO R10 00662000
  760. BCTR R3,0 SEE IF ANY MORE CHARACTERS TO BE CONVERTE 00663000
  761. LTR R3,R3 NO MORE IF R3 IS ZERO 00664000
  762. BNZ CONVERT1 R3 IS NON-ZERO, DO THE SECOND CHARACTER 00665000
  763. LA R1,QMSG SET UP ENTRY CONDITIONS FOR TYPLIHRC101DS 00666490
  764. LH R3,QMSGL LENGTH OF MESSAGE HRC101DS 00666980
  765. BAL R5,TYPEOUT TYPE OUT THE MESSAGE HRC101DS 00667470
  766. MVC QOPT,BLANKS BLANK OUT THE QUERIED POSITION 00668000
  767. MVC QSTATUS,QSTATUS-1 RE-INITIALIZE THE STATUS FIELD 00669000
  768. LA R6,1(,R6) START COMPARE AT NEXT BYTE 00670000
  769. BCTR R7,0 DECREMENT THE NUMBER COMPARED BY 1 00671000
  770. LA R8,1(,R8) COMPARE AT NEXT BYTE 00672000
  771. BCTR R9,0 DECREMENT THE NUMBER COMPARED BY 1 00673000
  772. SH R2,=H'2' REDUCE R2 TO CORRECT ADDRESS 00674000
  773. BR R13 TRANSFER 00675000
  774. EJECT 00676000
  775. * 00677000
  776. * OUTPUT. DISPLAY THE USER DEFINED OUTPUT TRANSLATE TABLE. 00678000
  777. * 00679000
  778. OUTPUT EQU * 00680000
  779. L R6,AOUTRTBL R6=A(USER DEFINED OUTPUT TRANSLATE TABLE) 00681000
  780. MVC QOPT,COUTPUT MOVE NAME OF THE OPTION QUERIED TO MSG. 00682000
  781. LA R13,OUTPUT10 RETURN HERE AFTER OUTPUTTING MESSAGE 00683000
  782. LA R8,OTRTABLE COMPARE USER TR TABLE TO STANDARD 00684000
  783. LA R3,15 15 CHARACTERS TO BE TYPED OUT EACH TIME 00685000
  784. STH R3,QMSGL STORE THE LENGTH OF THE MESSAGE 00686000
  785. LA R2,QSTATUS PLACE FOR CHAR. TRANSLATED TO 00687000
  786. LTR R6,R6 DOES USER DEFINED OUTPUT TR TABLE EXIST ? 00688000
  787. BNP OUTMSG NO, OUTPUT A MESSAGE 00689000
  788. LA R7,256 LENGTH OF THE TRANSLATE TABLE 00690000
  789. LA R9,256 LENGTH OF THE TRANSLATE TABLES 00691000
  790. OUTPUT10 EQU * COMPARE THE TWO TABLES 00692000
  791. CLCL R6,R8 00693000
  792. LTR R7,R7 ALL THRU ? 00694000
  793. BZ SR1515 YES, RETURN TO CALLER 00695000
  794. IC R10,0(,R6) GET THE TRANSLATION CHARACTER 00696000
  795. STC R10,QSTATUS+3 STORE IN THE OUTPUT MESSAGE 00697000
  796. LH R10,=H'256' DETERMINE LOCATION OF NON-MATCH 00698000
  797. SR R10,R7 00699000
  798. B CONV CONVERT THE LOC. TO PRINTABLE HEX 00700000
  799. EJECT 00701000
  800. * 00702000
  801. * LDRTBLS. INDICATE THE NUMBER OF LDRTBLS. 00703000
  802. * 00704000
  803. LDRTBLS EQU * 00705000
  804. MVC QOPT,CLDRTBLS QUERIED OPTION 00706000
  805. SR R6,R6 ZERO R6 00707000
  806. IC R6,ALDRTBLS GET THE NUMBER OF LOADER TABLES 00708000
  807. * 00709000
  808. * THE FOLLOWING CONVERTS THE NUMBER OF LDRTBLS TO PRINTABLE CHARACTERS 00710000
  809. * 00711000
  810. CVD R6,DEC CONVERT THE NUMBER TO DECIMAL 00712000
  811. UNPK DECDEC,DEC UNPACK IT 00713000
  812. OI DECDEC+7,X'F0' CLEAR THE SIGN FROM THE LAST BYTE 00714000
  813. * 00715000
  814. * 00716000
  815. MVC QSTATUS(3),DECDEC+5 MOVE THE NUMBER INTO THE MSG 00717000
  816. LA R3,3(,R3) 3 CHARACTERS ADDED TO THE OUTPUT MSG 00718000
  817. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00719490
  818. SPACE 3 00720000
  819. * 00721000
  820. * DOSPART. INDICATE THE SIZE OF THE DOS PARTITION. 00722000
  821. * 00723000
  822. DOSPART TM DOSFLAGS,DOSMODE CMS/DOS MODE ACTIVE ? @VA04299 00724000
  823. BZ ERROR099 NO, ERROR @VA04299 00725000
  824. MVC QOPT,CDOSPART QUERIED FUNCTION @VA04299 00726000
  825. SR R6,R6 ZERO R6 @VA04299 00727000
  826. ICM R6,3,DOSKPART GET SIZE IN K-BYTES @VA04299 00728000
  827. BZ DOSPART2 IF NONE SPECIFIED, TELL USER. @VA04299 00729000
  828. * 00730000
  829. * THE FOLLOWING CONVERTS THE SIZE OF DOSPART TO PRINTABLE CHARACTERS 00731000
  830. * 00732000
  831. CVD R6,DEC CONVERT THE NUMBER TO DECIMAL @VA04299 00733000
  832. UNPK DECDEC,DEC UNPACK IT @VA04299 00734000
  833. OI DECDEC+7,X'F0' CLEAR THE SIGN FROM LAST BYTE @VA04299 00735000
  834. * 00736000
  835. * 00737000
  836. MVC QSTATUS(5),DECDEC+3 MOVE THE SIZE INTO THE MSG @VA04299 00738000
  837. MVI QSTATUS+5,C'K' MOVE THE CHARACTER 'K' @VA04299 00739000
  838. LA R3,6(,R3) 6 CHARACTERS ADDED TO THE MSG @VA04299 00740000
  839. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00741490
  840. SPACE 2 00742000
  841. DOSPART2 MVC QSTATUS(4),NONE MOVE 'NONE' INTO THE MSG @VA04299 00743000
  842. LA R3,4(,R3) 4 CHARACTERS ADDED TO THE MSG @VA04299 00744000
  843. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00745490
  844. EJECT 00746000
  845. * 00747000
  846. * LIBRARY. INDICATE THE TEXT AND MACRO LIBRARIES BEING SEARCHED TO 00748000
  847. * RESOLVE REFERENCES. 00749000
  848. * 00750000
  849. LIBRARY EQU * 00751000
  850. LA R5,DOSLIB AFTER TXTLIB, GO TO DOSLIB @V305001 00752000
  851. ST R5,NEXTLIB ... @V305001 00753000
  852. LA R5,TXTLIB AFTER TYPEOUT, RETURN TO TXTLIB 00754000
  853. MACLIB EQU * OUTPUT MACLIB NAMES CURRENTLY IN EFFECT 00755000
  854. MVC QOPT,CMACLIB OPTION QUERIED 00756000
  855. LA R7,MACLIBL A(MACLIB NAMES CURRENTLY IN EFFECT) 00757000
  856. LIBENTRY EQU * CHECK EXISTENCE OF LIBRARY NAMES 00758000
  857. LA R6,QSTATUS MOVE LIBRARY STATUS HERE 00759000
  858. CLI 0(R7),FENCE ARE ANY LIBRARY NAMES IN EFFECT? HRC101DS 00760490
  859. BE TYPENONE NO, INSERT 'NONE' AND TYPEOUT 00761000
  860. LA R8,9 NUMBER OF POSSIBLE LIBRARIES 00762000
  861. NEXTNAME EQU * GET NEXT (OR FIRST) LIBRARY NAME 00763000
  862. MVC 0(8,R6),0(R7) MOVE LIBRARY NAME TO TYPEOUT BUFFER 00764000
  863. MVI 8(R6),C' ' DELIMITER 00765000
  864. LA R3,9(,R3) 9 CHARACTERS MOVED TO TYPEOUT BUFFER 00766000
  865. LA R6,9(,R6) ADVANCE TO NEXT POSITION IN TYPEOUT BUFF. 00767000
  866. LA R7,8(,R7) ADVANCE TO NEXT LIBRARY NAME 00768000
  867. CLI 0(R7),FENCE END OF LIBRARY NAME LIST HRC101DS 00769590
  868. BE TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00770180
  869. BCT R8,NEXTNAME MOVE NEXT NAME TO TYPE OUT LINE 00771000
  870. TXTLIB EQU * OUTPUT TXTLIB NAMES CURRENTLY IN EFFECT 00772000
  871. MVC QSTATUS,QSTATUS-1 BLANK OUT THE STATUS LINE 00773000
  872. L R5,NEXTLIB GET RETURN POINT @V305001 00774000
  873. MVC QOPT,CTXTLIB OPTION QUERIED 00775000
  874. LA R3,ELEVEN RESTORE R3 TO ELEVEN @VA06340 00776000
  875. LA R7,TXTLIBS A(TXTLIB NAMES CURRENTLY IN EFFECT) 00777000
  876. B LIBENTRY MOVE NAMES TO TYPEOUT LINE 00778000
  877. DOSLIB EQU * OUTPUT DOSLIB NAMES IN EFFECT @V305001 00779000
  878. MVC QSTATUS,QSTATUS-1 BLANK OUT STATUS LINE @V305001 00780000
  879. LA R5,SR1515 RETURN TO CALLER AFTER TYPEOUT @V305001 00781000
  880. MVC QOPT,CDOSLIB OPTION QUERIED @V305001 00782000
  881. LA R7,DOSLIBL DOSLIB NAMES CURRENT GLOBALED @V305001 00783000
  882. LA R3,ELEVEN RESTORE R3 TO ELEVEN @VA06340 00784000
  883. B LIBENTRY MOVE NAMES TO TYPEOUT LINE @VA06340 00785000
  884. TYPENONE EQU * NO TXTLIB OR MACLIB ENTRIES 00786000
  885. MVC 0(4,R6),NONE NO LIBRARY NAMES 00787000
  886. LA R3,4(,R3) 4 CHARACTERS ADDED TO TYPEOUT LINE 00788000
  887. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00789490
  888. EJECT 00790000
  889. * 00791000
  890. * LINECT. IF DOS ENVIRONMENT ACTIVE, TYPE OUT SYSLST LINES PER 00792000
  891. * PAGE VALUE 00793000
  892. * 00794000
  893. LINECT DS 0H @V505098 00795000
  894. TM DOSFLAGS,DOSMODE IS CMS/DOS ACTIVE?? @V505098 00796000
  895. BZ ERROR099 NO, ERROR @V505098 00797000
  896. CLI 8(R2),FENCE ANY ARGUMENTS SPECIFIED?? HRC101DS 00798490
  897. BNE ERROR070 YES, INVALID PARAMETER @V505098 00799000
  898. MVC QOPT,CLINECT OPTION QUERIED @V505098 00800000
  899. L R10,ABGCOM GET ADDRES OF COMM. REGIO @V505098 00801000
  900. USING BGCOM,R10 SET UP ADDRESSABILITY TO COMM. REG@V505098 00802000
  901. SR R6,R6 CLEAR OUT VALUE REGISTER @V505098 00803000
  902. IC R6,SYSLINE GET DEFAULT SYSLST LINES/PAGE NO. @V505098 00804000
  903. DROP R10 GET RID OF ADDRESSABILITY @V505098 00805000
  904. CVD R6,DEC CONVERT LINES/PAGE VALUE TO DEC. @V505098 00806000
  905. OI DEC+7,15 MAKE SURE SIGN IS A 'F' @V505098 00807000
  906. UNPK QSTATUS(3),DEC(8) UNPACK FOR TRANSLATION @V505098 00808000
  907. LA R3,3(,R3) ADD LINES/PAGE LENGTH TO LENGTH @V505098 00809000
  908. * OF MESSAGE TO BE PRINTED 00810000
  909. B TYPEQMSG GO TYPE OUT THE MESSAGE HRC101DS 00811490
  910. EJECT 00812000
  911. * 00813000
  912. * RDYMSG. INDICATE RDYMSG=LMSG|SMSG|OFF 00814000
  913. * 00815000
  914. RDYMSG EQU * 00816000
  915. MVC QOPT,CRDYMSG OPTION QUERIED 00817000
  916. TM MSGFLAGS,NORDYTIM RDYMSG=SMSG? 00818000
  917. BO RDYSHORT YES 00819000
  918. MVC QSTATUS(4),LMSG RDYMSG=LMSG 00820000
  919. LA R3,4(,R3) 4 CHARACTERS ADDED TO THE OUTPUT MESSAGE 00821000
  920. B TYPEQMSG TYPE OUT THE MESSAGE HRC101DS 00822490
  921. RDYSHORT EQU * 00823000
  922. MVC QSTATUS(4),SMSG RDYMSG=SMSG 00824000
  923. LA R3,4(,R3) 4 CHARACTERS ADDED TO THE OUTPUT MESSAGE 00825000
  924. B TYPEQMSG TYPE OUT THE MESSAGE HRC101DS 00826490
  925. SPACE 2 00827000
  926. * 00828000
  927. * REDTYPE. INDICATE WHETHER REDTYPE=ON|OFF 00829000
  928. * 00830000
  929. REDTYPE EQU * 00831000
  930. MVC QOPT,CREDTYPE OPTION QUERIED 00832000
  931. TM MSGFLAGS,REDERRID REDTYPE ON? 00833000
  932. BO OPTON YES, REDTYPE=ON 00834000
  933. B OPTOFF NO, REDTYPE=OFF 00835000
  934. SPACE 2 00836000
  935. * 00837000
  936. * RELPAGE. INDICATE WHETHER RELPAGE=ON|OFF 00838000
  937. * 00839000
  938. RELPAGE EQU * 00840000
  939. MVC QOPT,CRELPAGE OPTION QUERIED 00841000
  940. TM OPTFLAGS,NOPAGREL PAGE RELEASE OFF? 00842000
  941. BO OPTOFF YES, RELPAGE=OFF 00843000
  942. B OPTON NO, RELPAGE=ON 00844000
  943. EJECT 00845000
  944. * 00846000
  945. * SYNONYM. DISPLAY USER|SYSTEM|ALL SYNONYMS IN EFFECT. 00847000
  946. * 00848000
  947. SYNONYM EQU * 00849000
  948. L R11,AUSABRV GET SYNONYM INFORMATION 00850000
  949. USING ABDSECT,R11 00851000
  950. CLC =C'ALL ',8(R2) ALL SYNONYMS IN EFFECT WANTED DISPLAYED ? 00852000
  951. BNE TSTSYS NO, SEE IF SYSTEM SYNONYMS WANTED 00853000
  952. B SYSSYN DISPLAY SYSTEM SYNONYMS FIRST 00855000
  953. TSTSYS EQU * SEE IF SYSTEM SYNONYMS WANTED 00856000
  954. CLC =C'USER ',8(R2) USER SYSNONYMS ONLY WANTED 00857000
  955. BE USRSYN YES, DISPLAY USER SYNONYMS 00858000
  956. CLC =C'SYSTEM ',8(R2) SYSTEM SYNONYMS WANTED 00859000
  957. BNE ERROR026 NO, TYPE OUT ERROR MESSAGE 00860000
  958. SYSSYN EQU * 00861000
  959. LA R1,ONEIDLE CARRIAGE-RETURN AFTERWARDS HRC101DS 00862490
  960. LA R3,1 LENGTH OF ONE HRC101DS 00862980
  961. BAL R5,TYPEOUT HRC101DS 00863470
  962. TM OPTFLAGS,NOSTDSYN STANDARD SYNOYMS=OFF? 00864000
  963. BO SYNMSG TYPE OUT MESSAGE 00865000
  964. SPACE , HRC101DS 00866490
  965. OKPS EQU * HRC101DS 00866980
  966. LA R1,FIRST FIRST MESSAGE HRC101DS 00867470
  967. LA R3,L'FIRST LENGTH MESSAGE HRC101DS 00867960
  968. BAL R5,TYPEOUT TYPE IT OUT HRC101DS 00868450
  969. LA R1,FIRST1 SECOND MESSAGE HRC101DS 00868940
  970. LA R3,L'FIRST1 LENGTH MESSAGE HRC101DS 00869430
  971. BAL R5,TYPEOUT TYPE IT OUT HRC101DS 00869920
  972. LA R1,FIRST2 THIRD MESSAGE HRC101DS 00870410
  973. LA R3,L'FIRST2 LENGTH MESSAGE HRC101DS 00870900
  974. BAL R5,TYPEOUT TYPE IT OUT HRC101DS 00871390
  975. LA R1,SYSCOM SET UP R1 FOR TYPEOUTS HRC101DS 00871880
  976. SR R6,R6 CLEAR R6 (FOR 'IC' BELOW) 00873000
  977. LM R7,R9,REGTABA PREPARE TO ACCESS SYSTEM ABBREVIATIONS 00874000
  978. * 00875000
  979. SYSLOOP MVC SYSABB,BLANKS BLANK OUT ABBREVIATION 00876000
  980. MVC SYSCOM(8),0(R7) MOVE IN SYSTEM COMMAND 00877000
  981. IC R6,8(,R7) GET COUNT OF SHORTEST 00878000
  982. LR R3,R6 SAVE FOR HRC101DS 00878500
  983. BCTR R6,0 FORM (LESS 1) 00879000
  984. EX R6,DMVC MOVE SHORTEST-FORM TO TYPEOUT, 00880000
  985. LA R1,SYSCOM MESSAGE TO DISPLAY HRC101DS 00881090
  986. LA R3,(L'SYSCOM+L'SYSABB) HRC101DS 00881180
  987. LR R6,R5 SAVE R5 HRC101DS 00881270
  988. BAL R5,TYPEOUT CALL TYPLIN (DELETES TERMINAL BLAHRC101DS 00881360
  989. LR R5,R6 RESTORE R5 HRC101DS 00881450
  990. BXLE R7,R8,SYSLOOP ITERATE FOR ALL SYSTEM COMMANDS 00882000
  991. CRAFTER EQU * 00883000
  992. LA R1,ONEIDLE CARRIAGE-RETURN AFTERWARDS HRC101DS 00884590
  993. LA R3,1 LENGTH OF ONE HRC101DS 00885180
  994. LA R5,USRSYN YES, AFTER SYSTEM SYNONYM TYPEOUTHRC101DS 00885770
  995. B TYPEOUT HRC101DS 00886360
  996. * (NOTE -- NOT AN 'ERROR') 00887000
  997. EJECT 00888000
  998. * 00889000
  999. * 00890000
  1000. * COMES HERE TO TYPE OUT USER SYNONYMS (IF ANY) 00891000
  1001. USRSYN EQU * TYPE OUT USER SYNONYMS 00892000
  1002. LA R5,SR1515 AFTER TYPEOUT RETURN TO CALLER HRC372DS 00893000
  1003. LM R7,R9,USABRV+4 PREPARE TO ACCESS USER SYNONYMS 00894000
  1004. LTR R7,R7 (IF ANY) 00895000
  1005. BC 8,SYNMSG2 TELL USER THAT NONE EXISTS 00896000
  1006. LA R1,SECOND PRELIMINARY HEADER FOR USER SYN'SHRC101DS 00897590
  1007. LA R3,L'SECOND ... HRC101DS 00898180
  1008. BAL R5,TYPEOUT ... HRC101DS 00898770
  1009. LA R1,SECOND1 ... HRC101DS 00899360
  1010. LA R3,L'SECOND1 ... HRC101DS 00899950
  1011. BAL R5,TYPEOUT ... HRC101DS 00900540
  1012. LA R1,SECOND2 ... HRC101DS 00901130
  1013. LA R3,L'SECOND2 ... HRC101DS 00901720
  1014. BAL R5,TYPEOUT ... HRC101DS 00902310
  1015. LA R1,SYSCOM2 SET UP R1 FOR TYPEOUTS HRC101DS 00902900
  1016. SR R6,R6 (FOR 'IC' BELOW) 00904000
  1017. * 00905000
  1018. USRLOOP MVC USERABB2,BLANKS BLANK OUT ABBREVIATION (IF ANY) 00906000
  1019. MVC SYSCOM2(8),0(R7) MOVE IN SYSTEM-COMMAND, 00907000
  1020. MVC USERSYN2(8),8(R7) USER SYNONYM, 00908000
  1021. CLI 16(R7),00 DOES 'SHORT FORM' OF USER-SYN 00909000
  1022. BE NOSHRT EXIST ? 00910000
  1023. CLI 16(R7),07 ONLY YES I NUMBER FROM 1 TO 7 00911000
  1024. BH NOSHRT ... 00912000
  1025. IC R6,16(,R7) LOOK AT (N+1)TH BYTE OF 00913000
  1026. LA R15,8(R7,R6) POINT TO END OF SHORT FORM @VA02593 00914000
  1027. CLI 0(R15),C' ' IS IT BLANK? @VA02593 00915000
  1028. BE NOSHRT IF YES, IT CAN'T BE A SHORT-FORM 00916000
  1029. BCTR R6,0 IF NON-BLANK, MOVE IN SHORT-FORM HRC101DS 00917490
  1030. EX R6,DMVC2 OF USER-SYNONYM. 00918000
  1031. SPACE , HRC101DS 00919190
  1032. NOSHRT EQU * HRC101DS 00919380
  1033. LA R3,(L'SYSCOM2+L'USERSYN2+L'USERABB2) HRC101DS 00919570
  1034. BAL R5,TYPEOUT HRC101DS 00919760
  1035. BXLE R7,R8,USRLOOP ITERATE FOR ALL USER ABBREVIATIONS 00920000
  1036. LA R1,ONEIDLE CARRIAGE-RETURN AFTERWARDS HRC101DS 00921590
  1037. LA R3,1 LENGTH OF ONE HRC101DS 00922180
  1038. LA R5,SR1515 AFTER TYPEOUT RETURN TO CALLER HRC101DS 00922770
  1039. B TYPEOUT RETURN TO CALLER HRC101DS 00923360
  1040. EJECT 00924000
  1041. * DISPLAY THE CONTENTS OF THE SYSNAMES TABLE FOR SAVED SYSTEMS 00925000
  1042. * 00926000
  1043. QRYSYSN EQU * @V305614 00927000
  1044. CLI 8(R2),FENCE NO OTHER PARAMETERS @V305066 00928000
  1045. BNE ERROR026 VALID @V305614 00929000
  1046. SPACE 1 00930000
  1047. L R11,ASYSNAMS GET SYSNAMES TABLE @V305614 00931000
  1048. USING SYSNAMES,R11 ADDRESSABILITY @V305614 00932000
  1049. LA R1,ONEIDLE HRC101DS 00933490
  1050. LA R3,1 HRC101DS 00933980
  1051. BAL R5,TYPEOUT HRC101DS 00934470
  1052. LA R1,SYSN1 POINT TO 1ST LINE HRC101DS 00934960
  1053. LA R3,L'SYSN1 HRC101DS 00935450
  1054. BAL R5,TYPEOUT HRC101DS 00935940
  1055. SPACE 1 00937000
  1056. LA R6,FOUR GET NUMBER OF ENTRIES @V305066 00938000
  1057. LA R7,CMSSEG POINT TO 1ST ENTRY @V305614 00939000
  1058. LA R8,SYSN2+11 POINT TO OUTPUT AREA @V305614 00940000
  1059. SPACE 1 00941000
  1060. SYSNLOOP MVC 0(8,R8),0(R7) PLUG SYSNAMES ENTRY @V305614 00942000
  1061. LA R7,8(,R7) BUMP SYSNAMES POINTER @V305614 00943000
  1062. LA R8,10(,R8) AND OUTPUT POINTER @V305614 00944000
  1063. BCT R6,SYSNLOOP FILL IT UP @V305614 00945000
  1064. SPACE 1 00946000
  1065. LA R1,SYSN2 POINT TO 2ND LINE HRC101DS 00947590
  1066. LA R3,L'SYSN2 HRC101DS 00948180
  1067. BAL R5,TYPEOUT HRC101DS 00948770
  1068. LA R1,ONEIDLE HRC101DS 00949360
  1069. LA R3,1 HRC101DS 00949950
  1070. LA R5,SR1515 RETURN TO CALLER HRC101DS 00950540
  1071. B TYPEOUT HRC101DS 00951130
  1072. EJECT 00952000
  1073. * 00953000
  1074. * PROTECT. INDICATE WHETHER PROTECT = ON|OFF 00954000
  1075. * 00955000
  1076. SPACE 00956000
  1077. PROTECT EQU * 00957000
  1078. MVC QOPT,CPROTECT NAME OF FUNCTION 00958000
  1079. TM PROTFLAG,PRFPOFF IS FLAG ON 00959000
  1080. BO OPTOFF YES, STATUS = OFF 00960000
  1081. B OPTON NO, STATUS = ON 00961000
  1082. SPACE 2 00962000
  1083. * 00963000
  1084. * DOS. INDICATE WHETHER DOS = ON|OFF 00964000
  1085. * 00965000
  1086. SPACE 1 00966000
  1087. DOS EQU * @V305001 00967000
  1088. MVC QOPT,CDOS NAME OF FUNCTION @V305001 00968000
  1089. TM DOSFLAGS,DOSMODE+DOSSVC ARE FLAGS ON ? @V305001 00969000
  1090. BNZ OPTON ONE MUST HAVE BEEN ON @VA09636 00972000
  1091. SPACE 2 00974000
  1092. * 00975000
  1093. * DISPLAY THE STATUS OF THE FLAG (ON | OFF) 00976000
  1094. * 00977000
  1095. SPACE 00978000
  1096. SPACE 2 00979000
  1097. OPTOFF EQU * THE STATUS OF THE QUERIED OPTION IS OFF 00980000
  1098. MVC QSTATUS(3),=C'OFF' MOVE THE STATUS INTO THE MESSAGE 00981000
  1099. LA R3,3(,R3) 3 CHARACTERS ADDED TO THE MESSAGE 00982000
  1100. B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00983490
  1101. * 00984000
  1102. OPTON EQU * THE STATUS OF THE QUERIED OPTION IS ON 00985000
  1103. MVC QSTATUS(2),=C'ON' MOVE THE STATUS INTO THE MESSAGE 00986000
  1104. LA R3,2(,R3) 2 CHARACTERS ADDED TO THE MESSAGE 00987000
  1105. * 00988000
  1106. TYPEQMSG EQU * TYPE OUT THE MESSAGE HRC101DS 00989090
  1107. LA R1,QMSG ADDRESS OF BUFFER HRC101DS 00989180
  1108. TYPEOUT EQU * TYPE OUT THE MESSAGE HRC101DS 00989270
  1109. TM OPTSFLAG,OPTSTACK STACK RESULTS ? HRC101DS 00989360
  1110. BO STACKOUT YES, CONTINUE HRC101DS 00989450
  1111. ST R1,PTYPBUF SET THE ADDRESS OF THE MESSAGE HRC101DS 00989540
  1112. STH R3,QMSGL LENGTH OF THE MESSAGE FOR TYPLIN 00990000
  1113. LA R1,PTYPLIN ADDRESS OF TYPLIN PLIST 00991000
  1114. SVC 202 TYPE IT OUT 00992000
  1115. L R1,PTYPBUF RESTORE R1 HRC101DS 00992500
  1116. BR R5 SEE IF USER QUERIES MORE OPTIONS ? 00993000
  1117. SPACE , HRC101DS 00993060
  1118. STACKOUT DS 0H HRC101DS 00993120
  1119. TM OPTSFLAG,OPTLIFO HRC101DS 00993180
  1120. BNO STACKFIF HRC101DS 00993240
  1121. MVC PSTKDIR,=CL8'LIFO' HRC101DS 00993300
  1122. SPACE , HRC101DS 00993360
  1123. STACKFIF EQU * HRC101DS 00993420
  1124. ST R1,PSTKBUF ADDRESS OF BUFFER HRC101DS 00993480
  1125. STC R3,PSTKBUF LENGTH OF MESSAGE HRC101DS 00993540
  1126. LA R1,PSTKLIN ADDRESS OF STACK PLIST HRC101DS 00993600
  1127. SVC 202 STACK IT NOW HRC101DS 00993660
  1128. DC AL4(ERR109S) ERROR FROM SVC HRC101DS 00993720
  1129. L R1,PSTKBUF RESTORE R1 HRC101DS 00993780
  1130. BR R5 RETURN TO CALLER HRC101DS 00993840
  1131. EJECT 00994000
  1132. * HRC322DS 00994010
  1133. * CP QUERY with STACK option. Issue the CP command and place HRC322DS 00994020
  1134. * the result on the stack. HRC322DS 00994030
  1135. CPQUERY DS 0H HRC322DS 00994040
  1136. S R2,=F'8' R2 now points to QUERY command HRC322DS 00994050
  1137. LA R3,CPCMND point to buffer for CP command HRC322DS 00994060
  1138. SLR R5,R5 zero buffer length HRC322DS 00994070
  1139. * Loop to build up the CP command. HRC322DS 00994080
  1140. CPPARMLP DS 0H copy CMS tokens to CP command HRC322DS 00994090
  1141. MVC 0(8,R3),0(R2) copy token HRC322DS 00994100
  1142. MVI 8(R3),C' ' add a blank HRC322DS 00994110
  1143. LA R2,8(R2) bump to next token HRC322DS 00994120
  1144. LA R3,9(R3) update CP command pointer HRC322DS 00994130
  1145. LA R5,9(R5) accumulate length HRC322DS 00994140
  1146. CLI 0(R2),X'FF' all done? HRC322DS 00994150
  1147. BE CPQUERY1 yes, go issue the CP command HRC322DS 00994160
  1148. CLI 0(R2),C'(' is it the start of options? HRC322DS 00994170
  1149. BNE CPPARMLP no, so process next token HRC322DS 00994180
  1150. CPQUERY1 DS 0H issue the CP command HRC322DS 00994190
  1151. LA R0,1024 buffer for CP output (in DWORDs) HRC322DS 00994200
  1152. DMSFREE DWORDS=(0),MSG=NO,ERR=ERR109S,TYPCALL=BALR HRC322DS 00994210
  1153. LR R9,R1 save buffer address HRC322DS 00994220
  1154. LA R2,CPCMND address of CP command HRC322DS 00994230
  1155. LR R3,R9 address of buffer for CP output HRC322DS 00994240
  1156. SLL R0,3 convert to bytes HRC322DS 00994250
  1157. LR R6,R0 size of output buffer HRC322DS 00994260
  1158. LR R1,R5 save CP command length HRC322DS 00994270
  1159. ICM R5,8,=X'40' set flag for output to buffer HRC322DS 00994280
  1160. * Issue the CP command, with output directed to our buffer. HRC322DS 00994290
  1161. DIAG R2,R5,8 at last we issue the CP command HRC322DS 00994300
  1162. BC 4,CPQUERY4 buffer overflow HRC322DS 00994310
  1163. LTR R8,R5 save return code from CP HRC322DS 00994320
  1164. BNZ CPQUERY6 don't stack results if error HRC322DS 00994330
  1165. LTR R6,R6 any output from CP? HRC322DS 00994340
  1166. BZ CPQUERY5 no, set return code and exit HRC322DS 00994350
  1167. LR R3,R9 CP output buffer HRC322DS 00994360
  1168. BCTR R3,0 prime the pump HRC322DS 00994370
  1169. * Loop to place each output line from CP on the stack. HRC322DS 00994380
  1170. CPNXTLIN DS 0H HRC322DS 00994390
  1171. LA R3,1(R3) skip previous linend character HRC322DS 00994400
  1172. LR R1,R3 start of this line HRC322DS 00994410
  1173. * Loop to find the end of this line. HRC322DS 00994420
  1174. CPNXTCHR DS 0H HRC322DS 00994430
  1175. CLI 0(R3),X'15' are we at the end of this line? HRC322DS 00994440
  1176. BE CPQUERY2 yes, go stack it HRC322DS 00994450
  1177. LA R3,1(R3) no, on to next character HRC322DS 00994460
  1178. BCT R6,CPNXTCHR continue loop until buffer end HRC322DS 00994470
  1179. * We have a line, now stack it. HRC322DS 00994480
  1180. CPQUERY2 DS 0H HRC322DS 00994490
  1181. LR R7,R3 save scan pointer HRC322DS 00994500
  1182. SR R3,R1 length of this line of output HRC322DS 00994510
  1183. BCTR R6,0 account for linend character HRC322DS 00994520
  1184. LA R5,CPQUERY3 return address HRC322DS 00994530
  1185. B STACKOUT stack the line HRC322DS 00994540
  1186. CPQUERY3 DS 0H HRC322DS 00994550
  1187. L R1,PSTKBUF restore our buffer address HRC322DS 00994560
  1188. LR R3,R7 restore scan pointer HRC322DS 00994570
  1189. LTR R6,R6 more lines to process? HRC322DS 00994580
  1190. BP CPNXTLIN yes, go scan and stack them HRC322DS 00994590
  1191. B CPQUERY5 no, we are finished HRC322DS 00994600
  1192. * Wrap up and exit. HRC322DS 00994610
  1193. CPQUERY4 DS 0H HRC322DS 00994620
  1194. LA R8,88 return code of 88 HRC322DS 00994630
  1195. CPQUERY5 DS 0H HRC322DS 00994640
  1196. LA R0,1024 buffer size HRC322DS 00994650
  1197. LR R1,R9 get address of buffer HRC322DS 00994660
  1198. DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR HRC322DS 00994670
  1199. LR R15,R8 set return code HRC322DS 00994680
  1200. B EXIT return to caller HRC322DS 00994690
  1201. CPQUERY6 DS 0H HRC322DS 00994700
  1202. DIAG R2,R1,8 reissue CP cmd to show error msg HRC322DS 00994710
  1203. LR R15,R1 set return code HRC322DS 00994720
  1204. B EXIT return to caller HRC322DS 00994730
  1205. EJECT HRC322DS 00994740
  1206. * 00995000
  1207. * INFORMATIONAL AND ERROR MESSAGES 00996000
  1208. * 00997000
  1209. SPACE 2 HRC322DS 00997100
  1210. CMSLEVEL EQU * HRC322DS 00997200
  1211. LA R1,LEVELMSG address of CMSLEVEL message HRC322DS 00997300
  1212. L R3,=F'44' length of CMSLEVEL message HRC371DS 00997400
  1213. B TYPEOUT type or stack the message HRC322DS 00997500
  1214. LEVELMSG DC CL44'VM/370 Release 6, PLC 629, "SixPack" ver 1.2' 371DS 00997600
  1215. SPACE 2 00998000
  1216. NOTFOUND EQU * 00999000
  1217. CLC STRMAX,8(R2) WAS THAT Q DISK MAX ? HRC003DS 00999300
  1218. BE ERROR006 YES, SAY NO R/W DISK ACCESSED HRC003DS 00999600
  1219. LA R2,8(,R2) POINT TO THE MODE 01000000
  1220. LINEDIT SUB=(CHARA,(R2)),RENT=NO,TEXT='Disk ''........'' not a+01001000
  1221. ccessed',DISP=NONE,BUFFA=MSGBUFL HRC322DS 01001500
  1222. LA R1,MSGBUF address of message text HRC322DS 01002000
  1223. SR R3,R3 HRC322DS 01002500
  1224. IC R3,MSGBUFL length of message text HRC322DS 01003000
  1225. B TYPEOUT type or stack the message HRC322DS 01003500
  1226. SPACE 2 01004000
  1227. FLDFMSG EQU * 01005000
  1228. ERR324I DMSERR NUM=324,LET=I,SUB=(CHARA,(R7)),DISP=NONE,BUFFA=MSGBUFL,*01006000
  1229. TEXT='No user defined ........''s in effect' HRC322DS 01006500
  1230. LA R1,MSGBUF address of message text HRC322DS 01007000
  1231. SR R3,R3 HRC322DS 01007500
  1232. IC R3,MSGBUFL length of message text HRC322DS 01008000
  1233. B TYPEOUT type or stack the message HRC322DS 01008500
  1234. SPACE 2 01009000
  1235. SYNMSG EQU * 01010000
  1236. LA R1,SYNMSGNS address of message text HRC322DS 01011000
  1237. L R3,=F'28' length of message text HRC322DS 01011500
  1238. B TYPEOUT type or stack the message HRC322DS 01012000
  1239. SYNMSGNS DC CL28'No system synonyms in effect' HRC322DS 01012500
  1240. EJECT 01013000
  1241. SYNMSG2 EQU * 01014000
  1242. LA R1,SYNMSGNU address of message text HRC322DS 01015000
  1243. L R3,=F'26' length of message text HRC322DS 01015500
  1244. B TYPEOUT type or stack the message HRC322DS 01016000
  1245. SYNMSGNU DC CL26'No user synonyms in effect' HRC322DS 01016500
  1246. INPMSG EQU * 01017000
  1247. LA R1,INPMSGM address of message text HRC322DS 01018000
  1248. L R3,=F'44' length of message text HRC322DS 01018500
  1249. B TYPEOUT type or stack the message HRC322DS 01019000
  1250. INPMSGM DC CL44'No user defined input translate table in use' 01019500
  1251. SPACE 2 01020000
  1252. OUTMSG EQU * 01021000
  1253. LA R1,OUTMSGM address of message text HRC322DS 01022000
  1254. L R3,=F'45' length of message text HRC322DS 01022400
  1255. B TYPEOUT type or stack the message HRC322DS 01022800
  1256. OUTMSGM DC CL45'No user defined output translate table in use' 01023200
  1257. DS 0H HRC322DS 01023600
  1258. EJECT 01024000
  1259. ERROR003 EQU * HRC101DS 01025690
  1260. DMSERR NUM=3,LET=E,SUB=(CHARA,(R2)), P0705*01026380
  1261. TEXT='Invalid option: ........ specified' HRC322DS 01027070
  1262. LA R15,24 COMPLETION CODE P0705 01028000
  1263. B EXIT RETURN TO CALLER P0705 01029000
  1264. SPACE 2 HRC101DS 01029100
  1265. ERROR005 EQU * HRC101DS 01029200
  1266. DMSERR NUM=5,LET=E,SUB=(CHARA,(R2)), P0705*01029300
  1267. TEXT='No ''........ parameter'' specified' HRC322DS 01029400
  1268. LA R15,24 COMPLETION CODE HRC101DS 01029500
  1269. B EXIT RETURN TO CALLER HRC101DS 01029600
  1270. SPACE 2 01030000
  1271. ERROR006 EQU * HRC003DS 01030100
  1272. DMSERR NUM=6,LET=E,TEXT='No read/write disk accessed' HRC322DS 01030200
  1273. LA R15,24 RETURN CODE HRC003DS 01030300
  1274. B EXIT HRC003DS 01030400
  1275. SPACE 2 , HRC003DS 01030500
  1276. ERROR014 EQU * 01031000
  1277. DMSERR NUM=14,LET=E,SUB=(CHARA,(R2)),TEXT='Invalid function ''+01032000
  1278. ........''' HRC322DS 01033000
  1279. LA R15,24 COMPLETION CODE 01034000
  1280. B EXIT 01035000
  1281. EJECT 01036000
  1282. ERROR026 EQU * 01037000
  1283. LA R3,8(,R2) POINT TO THE INVALID ARGUMENT 01038000
  1284. DMSERR NUM=26,LET=E,SUB=(CHARA,(R3),CHARA,(R2)),RENT=NO,TEXT='+01039000
  1285. Invalid parameter ''........'' for ''........'' function+01040000
  1286. ' HRC322DS 01041000
  1287. LA R15,24 RETURN CODE 01042000
  1288. B EXIT RETURN TO CALLER 01043000
  1289. SPACE 2 01044000
  1290. ERROR047 EQU * 01045000
  1291. DMSERR NUM=47,LET=E,TEXT='No function specified' HRC322DS 01046000
  1292. LA R15,24 RETURN CODE 01047000
  1293. B EXIT 01048000
  1294. EJECT 01049000
  1295. ERROR070 EQU * 01050000
  1296. DMSERR NUM=70,LET=E,SUB=(CHARA,(R9)),TEXT='Invalid parameter '+01051000
  1297. '........''' HRC322DS 01052000
  1298. LA R15,24 RETURN CODE 01053000
  1299. B EXIT RETURN TO CALLER 01054000
  1300. SPACE 1 01055000
  1301. ERROR099 EQU * @V305001 01056000
  1302. DMSERR TEXT='CMS/DOS environment not active',NUM=99,LET=E 01057000
  1303. LA R15,RC40 RETURN CODE HRC322DS 01058000
  1304. B EXIT RETURN TO CALLER @V305001 01059000
  1305. SPACE 2 01060000
  1306. ERR109S EQU * @VA05247 01061000
  1307. DMSERR NUM=109,LET=S,TEXT='Virtual storage capacity exceeded' 01062000
  1308. LA R15,109 HRC322DS 01063000
  1309. B EXIT @VA05247 01064000
  1310. SPACE 2 @VA05247 01065000
  1311. * 01066000
  1312. * EXIT 01067000
  1313. * 01068000
  1314. SR1515 EQU * EXIT SUCCESSFULLY, R15=0 01069000
  1315. SR R15,R15 01070000
  1316. EXIT EQU * EXIT UNSUCCESSFULLY, R15>0 01071000
  1317. MVI MISCFLAG,ZERO RESET MODULE FLAG @VM05247 01072000
  1318. L R14,SAVE14 RESTORE R14 01073000
  1319. BR R14 RETURN TO CALLER 01074000
  1320. EJECT 01075000
  1321. * 01076000
  1322. * CONSTANTS AND STORAGE AREA 01077000
  1323. * 01078000
  1324. DS 0D 01079000
  1325. * 01080000
  1326. * STANDARD TRANSLATE TABLE FOR USER TERMINAL INPUT AND OUTPUT 01081000
  1327. * 01082000
  1328. OTRTABLE DC 256AL1(*-OTRTABLE) STANDARD OUTPUT TRANS. TABLE 01083000
  1329. ITRTABLE DC 129AL1(*-ITRTABLE) STANDARD INPUT TRANS. TABLE 01084000
  1330. UPA DC X'C1C2C3C4C5C6C7C8C9' TR LOWER ALHPA TO UPPER 01085000
  1331. UPAB DC 7AL1(*-UPAB+138) 01086000
  1332. UPJ DC X'D1D2D3D4D5D6D7D8D9' 01087000
  1333. UPJB DC 8AL1(*-UPJB+154) 01088000
  1334. UPS DC X'E2E3E4E5E6E7E8E9' 01089000
  1335. UPSB DC 86AL1(*-UPSB+170) 01090000
  1336. * 01091000
  1337. MVCINST MVC 0(*-*,R9),1(R9) TO MOVE PORTION OF TYPEOUT FORWARD 1 01092000
  1338. * 01093000
  1339. * TABLE OF FILEDEF DEVICES - MUST BE IN ORDER SPECIFIED 01094000
  1340. * 01095000
  1341. DUMMY DC CL8'DUMMY' 01096000
  1342. PRT DC CL8'PRT' 01097000
  1343. RDR DC CL8'RDR' 01098000
  1344. TERM DC CL8'TERMINAL' 01099000
  1345. TAP DC CL8'TAP' 01100000
  1346. DSK DC CL8'DISK' 01101000
  1347. PUN DC CL8'PUN' 01102000
  1348. CRT DC CL8'CRT' 01103000
  1349. FENCE EQU X'FF' @V305066 01104000
  1350. FOUR EQU 4 @V305066 01105000
  1351. ARGLEN EQU 8 @V305066 01106000
  1352. HEX01 EQU X'01' @V305066 01107000
  1353. ZONE EQU X'F0' @V305066 01108000
  1354. DUMP EQU X'40' @V305066 01109000
  1355. CHAR48C EQU X'02' @V305066 01110000
  1356. ZERO EQU X'00' @V305066 01111000
  1357. RC40 EQU 40 @V305066 01112000
  1358. SEVEN EQU 7 @VA04310 01113000
  1359. W EQU C'W' @V305066 01114000
  1360. ELEVEN EQU 11 @VA06340 01115000
  1361. * 01116000
  1362. T3340 EQU X'07' @V2A2014 01117000
  1363. T3350 EQU X'0B' @V304498 01118000
  1364. T2314 EQU X'08' @V2A2014 01119000
  1365. T3330 EQU X'09' @V2A2014 01120000
  1366. T3380 EQU X'0E' HRC003DS 01120500
  1367. * 01121000
  1368. DEC DS 1D USED FOR NUMBER CONVERSION 01122000
  1369. NEXTLIB DS 1F NEXT LIBRARY WHEN QUERY LIBRARY @V305001 01123000
  1370. * 01124000
  1371. PHEX1 DC X'000000F0' CONVERT 1 - 9 TO PRINTABLE HEX 01125000
  1372. PHEX2 DC X'000000C0' CONVERT A - F TO PRINTABLE HEX 01126000
  1373. DECDEC DS 1D USED FOR NUMBER CONVERSION 01127000
  1374. SPACE , HRC101DS 01128790
  1375. OPTSFLAG DC X'00' HRC101DS 01129580
  1376. OPTSTACK EQU X'80' STACK REQUESTED HRC101DS 01130370
  1377. OPTFIFO EQU X'08' FIFO REQUESTED HRC101DS 01131160
  1378. OPTLIFO EQU X'04' LIFO REQUESTED HRC101DS 01131950
  1379. SPACE , HRC101DS 01132740
  1380. DS 0F 01134000
  1381. SHORTCNT DC AL1(*-*) MSG-LENGTH FILLED IN 01138000
  1382. * 01139000
  1383. SHORTMSG DC CL8' ' DISK-LABEL AND TWO BLANKS JS 01140000
  1384. SHORT1 DC C'000 ' DEVICE-ADDRESS JS 01141000
  1385. SHORT2 DC C'Y,Z' E.G. "P " OR "A,P" ETC. 01142000
  1386. SHORT3 DC C' R/O' TWO BLANKS; R/O = READ-ONLY 01143000
  1387. * 01144000
  1388. SHORTRO EQU *-SHORTMSG LENGTH OF WHOLE SHORT MESSAGE 01145000
  1389. OSMSG DC C' - ???' APPEND FOR OS/DOS DISK @V305101 01146000
  1390. SHORTOS EQU SHORTRO+L'OSMSG LENGTH OF SHORT MSG + O/S @V201101 01147000
  1391. RO DC C'R/O' 01148000
  1392. RW DC C'R/W' 01149000
  1393. OSL DC CL3'OS' O/S DISK LITERAL @V305101 01150000
  1394. DOSL DC CL3'DOS' DOS DISK LITERAL @V305101 01151000
  1395. * 01152000
  1396. DS 0F ALIGN. 01153000
  1397. LISTLEN DC AL3(L'LISTMES) 01156000
  1398. LISTMES DC CL18' ' FOR DDNAMES AND DEVICE NAMES 01157000
  1399. LISTDSK DC CL18' ' FOR DSNAMES AND DSTYPES 01158000
  1400. GENLEN DC AL3(L'LISTMES) 01159000
  1401. DSKLEN DC AL3(L'LISTMES+L'LISTDSK) 01160000
  1402. * 01161000
  1403. * MESSAGE TO PRINT FOR P- OR T-DISK... 01162000
  1404. * 01163000
  1405. PTMSG EQU * HRC003DS 01164390
  1406. PTLABEL DC CL6' ',CL1' ' HRC003DS 01164780
  1407. PTUNIT DC CL3'000',CL1' ' HRC003DS 01165170
  1408. PTMODE DC CL1' ' HRC003DS 01165560
  1409. PTSLASH DC CL1' ' HRC003DS 01165950
  1410. PTMODEX DC CL1' ',CL1' ' HRC003DS 01166340
  1411. PTSTAT DC CL3' ' HRC003DS 01166730
  1412. ORG *-1 HRC003DS 01167120
  1413. PTCYL DC CL6' 0000',CL1' ' HRC003DS 01167510
  1414. PTTYPE DC CL4'0000',CL1' ' HRC003DS 01167900
  1415. PTBLKS DC CL4'0000' HRC003DS 01168290
  1416. ORG *-1 HRC003DS 01168680
  1417. PTFILES DC CL12'000000000000' HRC003DS 01169070
  1418. ORG *-1 HRC003DS 01169460
  1419. PTBLKUSD DC CL12'000000000000' HRC003DS 01169850
  1420. PTPCTUSD DC CL3'-00' HRC003DS 01170240
  1421. ORG *-1 HRC003DS 01170630
  1422. PTBLKFRE DC CL12'000000000000' HRC003DS 01171020
  1423. ORG *-1 HRC003DS 01171410
  1424. PTBLKTOT DC CL12'000000000000' HRC003DS 01171800
  1425. LPTMSG EQU *-PTMSG HRC003DS 01172190
  1426. * 01174000
  1427. FRSTFLAG DC X'00' HRC003DS 01175990
  1428. FRSTTIME EQU X'80' FIRST TIME THRU HRC003DS 01176980
  1429. QRWDSK EQU X'01' R/W DISK WANTED HRC003DS 01177970
  1430. * HRC003DS 01178960
  1431. DTITLE DC C'Label CUU M Stat Cyl Type Blksize Files Blks UseX01180940
  1432. d-(%) Blks Left Blk Total' HRC322DS 01181930
  1433. * 01184000
  1434. SAVE14 DS 1F R14 SAVED HERE 01185000
  1435. SAVE9 DS 1F R9 SAVED HERE HRC101DS 01185500
  1436. * 01186000
  1437. HEXTBL DC C'0123456789ABCDEF' 01187000
  1438. * 01204000
  1439. FIRST DC C'System Shortest' HRC322DS 01205000
  1440. FIRST1 DC C'Command Form' HRC322DS 01206000
  1441. FIRST2 DC C'-------- --------' 01207000
  1442. SYSCOM DC CL10' ' E.G. 'ALTER' GOES HERE 01208000
  1443. SYSABB DC CL8' ' E.G. 'AL' GOES HERE 01209000
  1444. BLANKS DC CL8' ' (FOR INITIALIZING SYSABB ETC.) 01210000
  1445. * 01211000
  1446. DMVC MVC SYSABB(*-*),0(R7) MOVES THE ABBREV. IN 01212000
  1447. MVC MVC QSTATUS(*-*),TIMCHAR STATUS =BLIP CHARACTERS 01213000
  1448. * 01214000
  1449. * CONSTANTS AND STORAGE FOR OUTPUTTING THE QUERY MESSAGE 01215000
  1450. * 01216000
  1451. PTYPLIN DS 0D PARAMETER LIST FOR TYPLIN 01217000
  1452. DC CL8'TYPLIN' MMODULE INVOKED 01218000
  1453. PTYPBUF DC A(QMSG) A(OUTPUT MESSAGE) HRC101DS 01219490
  1454. DC C'B',X'02' @VA06217 01220000
  1455. QMSGL DS 1H LENGTH OF THE OUTPUT MESSAGE 01221000
  1456. QMSG EQU * OUTPUT MESSAGE 01222000
  1457. QOPT DS CL8 OPTION QUERIED 01223000
  1458. QEQU DC C' = ' 01224000
  1459. QSTATUS DS CL118 STATUS OF OPTION QUERIED 01225000
  1460. NONE DC C'NONE' 01226000
  1461. SPACE 01227000
  1462. SMSG DC C'SMSG' SHORT MESSAGE(ERRMSG,RDYMSG) 01228000
  1463. LMSG DC C'LMSG' LONG MESSAGE(ERRMSG,RDYMSG) 01229000
  1464. SPACE , HRC101DS 01229100
  1465. PSTKLIN DS 0F STACK THE OUTPUT HRC101DS 01229200
  1466. DC CL8'ATTN' ATTN FUNCTION HRC101DS 01229300
  1467. PSTKDIR DC CL4'FIFO' HRC101DS 01229400
  1468. PSTKBUF DC A(0) LENGTH,ADDRESS HRC101DS 01229500
  1469. DS 0F 01230000
  1470. MSGBUFL DS CL1 length of text from LINEDIT HRC322DS 01231000
  1471. MSGBUF DS CL79 msg buffer: type or stack this HRC322DS 01232000
  1472. * 01234000
  1473. SECOND DC C'System User Shortest' HRC322DS 01235000
  1474. SECOND1 DC C'Command Synonym Form (if any)' HRC322DS 01236000
  1475. SECOND2 DC C'-------- -------- --------' 01237000
  1476. SYSCOM2 DC CL9' ' E.G. 'ERASE' GOES HERE 01238000
  1477. USERSYN2 DC CL9' ' E.G. 'DELETE' GOES HERE 01239000
  1478. USERABB2 DC CL8' ' E.G. 'DELET' GOES HERE 01240000
  1479. EUSERT EQU * (END OF THIS TYPEOUT) 01241000
  1480. * 01242000
  1481. ONEIDLE DC X'17' (TO TYPE ONE CARRIAGE-RETURN) 01243000
  1482. * 01244000
  1483. DMVC2 MVC USERABB2(*-*),8(R7) TO MOVE SHORT-FORM OF USER-SYN. 01245000
  1484. * 01246000
  1485. CPCMND DS CL132 COMMAND LINE 01249000
  1486. DC 4XL1'FF' END OF DMSCPF PLIST 01250000
  1487. * 01251000
  1488. DSKTBL EQU * TABLE OF VALID MODE LETTERS 01252000
  1489. DC C'A ' ADISK 01253000
  1490. DC C'B ' BDISK 01254000
  1491. DC C'C ' CDISK 01255000
  1492. DC C'D ' DDISK 01256000
  1493. DC C'E ' EDISK 01257000
  1494. DC C'F ' FDISK 01258000
  1495. DC C'G ' GDISK 01259000
  1496. DC C'H ' HDISK HRC002DS 01259080
  1497. DC C'I ' IDISK HRC002DS 01259160
  1498. DC C'J ' JDISK HRC002DS 01259240
  1499. DC C'K ' KDISK HRC002DS 01259320
  1500. DC C'L ' LDISK HRC002DS 01259400
  1501. DC C'M ' MDISK HRC002DS 01259480
  1502. DC C'N ' NDISK HRC002DS 01259560
  1503. DC C'O ' ODISK HRC002DS 01259640
  1504. DC C'P ' PDISK HRC002DS 01259720
  1505. DC C'Q ' QDISK HRC002DS 01259800
  1506. DC C'R ' RDISK HRC002DS 01259880
  1507. DC C'S ' SYSTEM DISK 01260000
  1508. DC C'T ' TDISK HRC002DS 01260100
  1509. DC C'U ' UDISK HRC002DS 01260200
  1510. DC C'V ' VDISK HRC002DS 01260300
  1511. DC C'W ' WDISK HRC002DS 01260400
  1512. DC C'X ' XDISK HRC002DS 01260500
  1513. DC C'Y ' YDISK 01261000
  1514. DC C'Z ' ZDISK 01262000
  1515. ENDTBL EQU *-2 END OF DISKTBL 01263000
  1516. * 01264000
  1517. * CONSTANTS FOR SYSNAMES OUTPUT 01265000
  1518. * 01266000
  1519. SPACE 1 01269000
  1520. SYSN1 DC C'SYSNAMES: CMSSEG CMSVSAM CMSAMS CMSDOS' 01270000
  1521. SYSN2 DC CL49' Entries:' HRC322DS 01271000
  1522. EJECT @VA05247 01272000
  1523. ***************************************************************@VA05247 01273000
  1524. * @VA05247 01274000
  1525. * THE USER HAS REQUESTED A LIST OF ALL CURRENT DOSCBS @VA05247 01275000
  1526. * @VA05247 01276000
  1527. ***************************************************************@VA05247 01277000
  1528. SPACE 1 @VA05247 01278000
  1529. DLBL EQU * LIST ALL DOSCB'S @VA05247 01279000
  1530. CLI 0(R9),FENCE 'LIST ALL' REQUEST? @VA05247 01280000
  1531. BE LISTALL YES... @VA05247 01281000
  1532. CLI 0(R9),C'(' HRC101DS 01281200
  1533. BNE DLBL100 HRC101DS 01281400
  1534. SPACE , HRC101DS 01281600
  1535. DLBL100 EQU * HRC101DS 01281800
  1536. CLI 8(R9),FENCE NO, BETTER HAVE FENCE HERE @VA05247 01282000
  1537. BE CKEXTNT OK, CHEK ONLY PARM ALLOWED @VA05247 01283000
  1538. CLI 0(R9),C'(' HRC101DS 01283300
  1539. BNE ERROR070 HRC101DS 01283600
  1540. LA R9,8(,R9) TOO MANY APRMS ENTERED... @VA05247 01284000
  1541. B ERROR070 ERROR. @VA05247 01285000
  1542. CKEXTNT CLC EXTENT,0(R9) 'EXTENT' ENTERED? @VA05247 01286000
  1543. BNE CKMULT NO, CHEK FOR MULT REQ... @VA05247 01287000
  1544. OI MISCFLAG,XEXTENT REMEMBER EXTENTS WANTED @VA05247 01288000
  1545. B LIST2D GO LOOK FOR THEM... @VA05247 01289000
  1546. CKMULT CLC MULT,0(R9) 'MULT' ENTERED? @VA05247 01290000
  1547. BNE ERROR070 NEITHER...ERROR @VA05247 01291000
  1548. OI MISCFLAG,XMULT REMEMBER MULT WANTED... @VA05247 01292000
  1549. B LIST2D GO LOOK FOR 'EM... @VA05247 01293000
  1550. SPACE 1 @VA05247 01294000
  1551. LISTALL EQU * LIST ALL DOSCB CONTENTS @VA05247 01295000
  1552. LA R0,LSTLEND GET DWORDS FOR LIST AREA @VA05247 01296000
  1553. LA R10,LISTHDR SUBRTN RETURN ADDR @VA05247 01297000
  1554. LISTPREP LH R2,DOSNUM GET NO. DOSCBS @VA05247 01298000
  1555. LTR R2,R2 ANY THERE? @VA05247 01299000
  1556. BZ ERR324I NO...EARLY OUT. @VA05247 01300000
  1557. LA R6,DOSFIRST LOAD A(DOSCB CHAIN ANCHOR) @VA05247 01301000
  1558. USING DOSSECT,R6 @VA05247 01302000
  1559. DMSFREE DWORDS=(0),ERR=ERR109S GET LIST AREA @VA05247 01303000
  1560. LR R3,R1 USE R3 FOR LIST @VA05247 01304000
  1561. USING DOSCBLST,R3 @VA05247 01305000
  1562. LR R8,R0 USE R8 FOR LINE CLEAR LENGTH@VA05247 01306000
  1563. SLL R8,3 CONVERT DWORDS TO BYTES @VA05247 01307000
  1564. BCTR R8,R0 MINUS 1 FOR CLEAR MVC @VA05247 01308000
  1565. BCTR R8,R0 MINUS 1 FOR CLEAR EXECUTE @VA05247 01309000
  1566. MVI 0(R3),BLANK CLEAR THE WORK AREA @VA05247 01310000
  1567. EX R8,EXCLR ... @VA05247 01311000
  1568. BR R10 RETURN TO CALLER (OR DROP) @VA05247 01312000
  1569. EXCLR MVC 1(*-*,R3),0(R3) ... @VA05247 01313000
  1570. SPACE 2 @VA05247 01314000
  1571. LISTHDR MVC 0(HEADLEN,R3),LISTHEAD HEADER TO WORK AREA @VA05247 01315000
  1572. LA R7,HEADLEN AND LENGTH OF SAME @VA05247 01316000
  1573. BAL R10,WRTERM GO DISPLAY THE HEADER @VA05247 01317000
  1574. SPACE 1 @VA05247 01318000
  1575. LISTLOOP EQU * LOOP FOR EACH DOSCB @VA05247 01319000
  1576. L R6,0(,R6) POINT TO NEXT DOSCB @VA05247 01320000
  1577. MVC LDDNAME,DOSDD GET DDNAME @VA05247 01321000
  1578. CLI DOSDEV,DOSDUM IS THIS ONE 'DUMMY'? @VA05247 01322000
  1579. BNE LISTMODE NO @VA05247 01323000
  1580. MVC LMODE,DUMMY YES, DISPLAY IT SO @VA05247 01324000
  1581. B LISTLOGU GO GET 'SYSXXX' @VA05247 01325000
  1582. LISTMODE MVC LMODE(L'DOSDSMD),DOSDSMD GET CMS DISKMODE @VA05247 01326000
  1583. SPACE 1 @VA05247 01327000
  1584. LISTLOGU TM DOSINIT,DOSOS 'OS' DLBL ISSUED? @VA05247 01328000
  1585. BO LISTYPE YES, SKIP SYSXXX PROCESS @VA05247 01329000
  1586. MVC LLOGUNIT,SYSXXX MOVE IN 'SYS' @VA05247 01330000
  1587. XR R8,R8 USE R8 FOR LUB CODE @VA05247 01331000
  1588. ICM R8,ONE,DOSXXX INSERT LUB CODE @VA05247 01332000
  1589. CLI DOSSYS,SYSLOG IS IT 'SYSTEM' UNIT? @VA05247 01333000
  1590. BNE LISTLOGP NO, PROCESS AS PROG... @VA05247 01334000
  1591. LA R7,UNITTAB SYSTEM...LOOK FOR 3 ALPHAS @VA05247 01335000
  1592. MH R8,THREE INDX TO TABLE ENTRY @VA05247 01336000
  1593. AR R7,R8 ... @VA05247 01337000
  1594. MVC LLOGXXX,0(R7) MOVE IT TO LIST @VA05247 01338000
  1595. B LISTYPE GOTO 'TYPE' FIELD... @VA05247 01339000
  1596. LISTLOGP CVD R8,PACKFLD GET CODE READY FOR LIST @VA05247 01340000
  1597. UNPK LLOGXXX,PACKFLD+6(L'LLOGXXX-1) LIST SYS CODE @VA05247 01341000
  1598. OI LLOGXXX+2,ZONE 'OR' FOR NUMERIC @VA05247 01342000
  1599. SPACE 1 @VA05247 01343000
  1600. LISTYPE CLI DOSTYPE,SAMDS SAM DATASET? @VA05247 01344000
  1601. BNE LISTVSAM NO, MUST BE VSAM... @VA05247 01345000
  1602. MVC LTYPE,SEQNTL 'SEQ' INTO LIST @VA05247 01346000
  1603. B LISTPERM SKIP BY ALL VSAM FIELDS... @VA05247 01347000
  1604. SPACE 1 @VA05247 01348000
  1605. LISTVSAM MVC LTYPE,VSAM 'VSAM' INTO LIST @VA05247 01349000
  1606. CLI DOSUCNAM,ZERO ANY USER CATALOG? @VA05247 01350000
  1607. BE LISTMCAT NO, DEFAULT TO MASTER @VA05247 01351000
  1608. MVC LCATALOG,DOSUCNAM PUT USER CAT NAME @VA05247 01352000
  1609. B LISTEXT AND CONTINUE... @VA05247 01353000
  1610. LISTMCAT MVC LCATALOG,MCAT 'IJSYSCT' INTO LIST @VA05247 01354000
  1611. LISTEXT XR R8,R8 USE R8 FOR EXT, VOL NOS. @VA05247 01355000
  1612. ICM R8,ONE,DOSEXTNO GET NO. EXTENTS @VA05247 01356000
  1613. CVD R8,PACKFLD PREP NUM FOR EDIT @VA05247 01357000
  1614. MVC EDIT,PATTERN SETUP PATTERN FIELD @VA05247 01358000
  1615. ED EDIT(L'LEXT+2),PACKFLD+6 FORMAT NO. EXTENTS @VA05247 01359000
  1616. MVC LEXT,EDIT+2 INTO LIST WITH IT.. @VA05247 01360000
  1617. LISTVOL ICM R8,ONE,DOSVOLNO GET NO. VOLUMES @VA05247 01361000
  1618. CVD R8,PACKFLD PREP NUM FOR EDIT @VA05247 01362000
  1619. MVC EDIT,PATTERN SETUP PATTERN @VA05247 01363000
  1620. ED EDIT(L'LVOL+2),PACKFLD+6 FORMAT NO. VOLS @VA05247 01364000
  1621. MVC LVOL,EDIT+2 INTO THE LIST @VA05247 01365000
  1622. LISTBUFS L R8,DOSBUFSP GET BUFFER SPACE @VA05247 01366000
  1623. CVD R8,PACKFLD PREP FOR EDIT @VA05247 01367000
  1624. MVC EDIT,PATTERN SETUP PATTERN @VA05247 01368000
  1625. ED EDIT(L'LBUFSPC+2),PACKFLD+4 FORMAT BUFSP PARM @VA05247 01369000
  1626. MVC LBUFSPC,EDIT+2 INTO THE LIST... @VA05247 01370000
  1627. SPACE 1 @VA05247 01371000
  1628. LISTPERM TM DOSINIT,DOSPERM DOSCB MARKED 'PERM'? @VA05247 01372000
  1629. BZ LISTNO NO, CONTINUE @VA05247 01373000
  1630. MVC LPERM,YES MOVE 'YES' TO LIST @VA05247 01374000
  1631. B LISTDISK AND CONTINUE @VA05247 01375000
  1632. LISTNO MVC LPERM,NO 'NO' TO LIST @VA05247 01376000
  1633. SPACE 1 @VA05247 01377000
  1634. LISTDISK TM DOSINIT,DOSDOS 'DOS' DISK DATASET? @VA05247 01378000
  1635. BZ LISTCMS NO, MUST BE CMS.. @VA05247 01379000
  1636. MVC LDISK,ZDOS 'DOS' DISK DATASET @VA05247 01380000
  1637. L R7,DOSOSDSN GET DOS(OS) DSNAME... @VA05247 01381000
  1638. LTR R7,R7 DO WE HAVE ONE? @VA05247 01382000
  1639. BZ LISTLIST NO, GOTO WRAP-UP... @VA05247 01383000
  1640. MVC LFILEID,0(R7) MOVE ENTIRE DOS FILEID @VA05247 01384000
  1641. B LISTLIST CONTINUE... @VA05247 01385000
  1642. LISTCMS MVC LDISK,CMS 'CMS' DISK DATASET @VA05247 01386000
  1643. MVC LFILENAM,DOSDSNAM LIST CMS FILENAME, @VA05247 01387000
  1644. MVC LFILETYP,DOSDSTYP AND CMS FILETYPE @VA05247 01388000
  1645. LISTLIST LA R7,LSTLEND*8 BYTE-LENGTH FOR DISPLAY @VA05247 01389000
  1646. BAL R10,WRTERM DISPLAY THE LINE @VA05247 01390000
  1647. BCT R2,LISTLOOP LOOP THRU DOSCB CHAIN... @VA05247 01391000
  1648. SPACE 1 @VA05247 01392000
  1649. LA R0,LSTLEND LIST AREA IN DWORDS @VA05247 01393000
  1650. LEND LR R1,R3 @VA05247 01394000
  1651. DMSFRET DWORDS=(0),LOC=(1) FRET WORK AREA @VA05247 01395000
  1652. TM MISCFLAG,XEXTENT+XMULT EXTENTS OR MULT WANTED? @VA05247 01396000
  1653. BZR R5 NO, CLOSE THE SHOP... @VA05247 01397000
  1654. TM MISCFLAG,XFOUND EXTENT OR MULT WANTED,FOUND?@VA05247 01398000
  1655. BOR R5 YES, END IN PEACE... @VA05247 01399000
  1656. LA R7,EXTENT ASSUME EXTENTS WANTED @VA05247 01400000
  1657. TM MISCFLAG,XEXTENT EXTENTS NOT FOUND? @VA05247 01401000
  1658. BO ERR324I YES...TELL THE USER. @VA05247 01402000
  1659. LA R7,MULT MULT.VOL LIST WANTED, @VA05247 01403000
  1660. B ERR324I SO SAY NONE FOUND. @VA05247 01404000
  1661. ***************************************************************@VA05247 01405000
  1662. * 'WRTERM' SUBRTN TO DISPLAY LINE: @VA05247 01406000
  1663. * ENTRY - R3 = A(LINE) @VA05247 01407000
  1664. * R7 = LINE LENGTH (BYTES) @VA05247 01408000
  1665. ***************************************************************@VA05247 01409000
  1666. WRTERM EQU * @VA05247 01410000
  1667. WRTERM (R3),(R7) @VA05247 01411000
  1668. BCTR R7,R0 MINUS 1 FOR CLEAR TECHNIQUE @VA05247 01412000
  1669. BCTR R7,R0 AND ONE MORE FOR MVC @VA05247 01413000
  1670. MVI 0(R3),BLANK BLANK THE WORK AREA AGAIN @VA05247 01414000
  1671. EX R7,EXCLR2 ... @VA05247 01415000
  1672. BR R10 RETURN TO CALLER @VA05247 01416000
  1673. EXCLR2 MVC 1(*-*,R3),0(R3) ... @VA05247 01417000
  1674. EJECT @VA05247 01418000
  1675. ***************************************************************@VA05247 01419000
  1676. * @VA05247 01420000
  1677. * 'DLBL EXTENT' OR 'DLBL MULT' ENTERED: @VA05247 01421000
  1678. * USER WISHES EXTENTS OR VOLUMES LISTED. @VA05247 01422000
  1679. * @VA05247 01423000
  1680. ***************************************************************@VA05247 01424000
  1681. LIST2D DS 0D EITHER EXTENTS OR VOLS WANTE@VA05247 01425000
  1682. LA R0,EXTLEND DWORDS FOR WORK AREA @VA05247 01426000
  1683. BAL R10,LISTPREP GET STORAGE AND INIT. STUFF @VA05247 01427000
  1684. USING EXTLIST,R3 @VA05247 01428000
  1685. MVC EHDR,LISTHEAD PROVIDE MOST OF HEADER @VA05247 01429000
  1686. TM MISCFLAG,XEXTENT EXTENTS WANTED? @VA05247 01430000
  1687. BZ L2LOOP IF NOT SKIP... @VA05247 01431000
  1688. MVC EEXTEND+1(L'EXTENT),EXTENT EXTENT HEADER @VA05247 01432000
  1689. SPACE 1 @VA05247 01433000
  1690. L2LOOP EQU * LOOP THRU ALL DOSCBS @VA05247 01434000
  1691. L R6,0(,R6) POINT TO NEXT DOSCB @VA05247 01435000
  1692. XR R11,R11 FOR LATER... @VA05247 01436000
  1693. TM MISCFLAG,XEXTENT LOOKING FOR EXTENTS? @VA05247 01437000
  1694. BZ LMLTPREP NO, CHEK MULT VOLS @VA05247 01438000
  1695. LA R7,DOSEXTNO POINT TO NO. EXTENTS @VA05247 01439000
  1696. L R9,DOSEXTTB AND EXTENT TABLE... @VA05247 01440000
  1697. LA R0,EXTLEN SIZE OF EXT TABLE ENTRY @VA05247 01441000
  1698. B ICMNUM SKIP TO CHEK ENTRIES @VA05247 01442000
  1699. LMLTPREP LA R7,DOSVOLNO POINT TO NO. VOLUMES @VA05247 01443000
  1700. L R9,DOSVOLTB AND VOLUME TABLE... @VA05247 01444000
  1701. LA R0,MULTLEN SIZE OF VOL TABLE ENTRY @VA05247 01445000
  1702. ICMNUM ICM R11,ONE,0(R7) LOAD NUM OF ENTRIES @VA05247 01446000
  1703. BZ L2END NEXT DOSCB IF NO ENTRIES @VA05247 01447000
  1704. CLI 0(R3),BLANK HAVE WE LISTED HDR YET? @VA05247 01448000
  1705. BE LDDMOVE YES, SKIP THRU... @VA05247 01449000
  1706. LA R7,EXTLEND*8 PROVIDE HDR LENGTH @VA05247 01450000
  1707. BAL R10,WRTERM DISPLAY THE HEADER @VA05247 01451000
  1708. OI MISCFLAG,XFOUND REMEMBER WE FOUND SOMETHING @VA05247 01452000
  1709. LDDMOVE MVC EDDNAME,DOSDD LIST DDNAME OF DOSCB @VA05247 01453000
  1710. SPACE 1 @VA05247 01454000
  1711. LBLKLOOP EQU * LOOP THRU TABLE ENTRIES @VA05247 01455000
  1712. MVC EMODE(L'EMODE-1),DMODE(R9) MOVE MODE TO LIST @VA05247 01456000
  1713. TM DOSINIT,DOSOS 'OS' DOSCB ? @VA05247 01457000
  1714. BO LEXTCHK2 YES, SKIP SYSXXX PROCESS @VA05247 01458000
  1715. MVC ELOGUNIT,SYSXXX MOVE IN 'SYS' @VA05247 01459000
  1716. XR R8,R8 USE R8 FOR LUB CODE @VA05247 01460000
  1717. ICM R8,ONE,DSYSCODE(R9) INSERT LUB CODE @VA05247 01461000
  1718. CLI DSYS(R9),SYSLOG IS IT 'SYSTEM' UNIT? @VA05247 01462000
  1719. BNE LSTLOGP2 NO, PROCESS AS PROG... @VA05247 01463000
  1720. LA R7,UNITTAB SYSTEM...LOOK FOR 3 ALPHAS @VA05247 01464000
  1721. MH R8,THREE INDX TO TABLE ENTRY @VA05247 01465000
  1722. AR R7,R8 ... @VA05247 01466000
  1723. MVC ELOGXXX,0(R7) MOVE IT TO LIST @VA05247 01467000
  1724. B LEXTCHK2 GO CHEK FOR EXTENTS... @VA05247 01468000
  1725. LSTLOGP2 CVD R8,PACKFLD GET CODE READY FOR LIST @VA05247 01469000
  1726. UNPK ELOGXXX,PACKFLD+6(L'ELOGXXX-1) LIST SYS CODE @VA05247 01470000
  1727. OI ELOGXXX+2,ZONE 'OR' FOR NUMERIC @VA05247 01471000
  1728. SPACE 1 @VA05247 01472000
  1729. LEXTCHK2 TM MISCFLAG,XEXTENT EXTENTS WANTED? @VA05247 01473000
  1730. BZ LDISPLAY NO, SKIP THRU... @VA05247 01474000
  1731. L R8,DEXTB(R9) GET BEGIN. OF EXTENT @VA05247 01475000
  1732. CVD R8,PACKFLD BINARY TO DECIMAL @VA05247 01476000
  1733. MVC EDIT,PATTERN PROVIDE EDIT PATTERN @VA05247 01477000
  1734. ED EDIT(L'EEXTBEG+2),PACKFLD+2 EDIT THE VALUE @VA05247 01478000
  1735. MVC EEXTBEG,EDIT+2 AND MOVE IT TO DISPLAY AREA @VA05247 01479000
  1736. L R8,DEXTE(R9) GET END OF EXTENT @VA05247 01480000
  1737. CVD R8,PACKFLD BINARY TO DECIMAL @VA05247 01481000
  1738. MVC EDIT,PATTERN PROVIDE EDIT PATTERN @VA05247 01482000
  1739. ED EDIT(L'EEXTEND+2),PACKFLD+2 EDIT THE VALUE @VA05247 01483000
  1740. MVC EEXTEND,EDIT+2 AND MOVE IT TO DISPLAY AREA @VA05247 01484000
  1741. LDISPLAY LA R7,EXTLEND*8 PROVIDE LINE LENGTH @VA05247 01485000
  1742. BAL R10,WRTERM DISPLAY THE GOODIES @VA05247 01486000
  1743. AR R9,R0 POINT TO NEXT TAB ENTRY @VA05247 01487000
  1744. BCT R11,LBLKLOOP GET NEXT ENTRY IN TABLE @VA05247 01488000
  1745. SPACE 1 @VA05247 01489000
  1746. L2END BCT R2,L2LOOP GET NEXT DOSCB @VA05247 01490000
  1747. LA R0,EXTLEND DWORDS TO DMSFRET @VA05247 01491000
  1748. B LEND GO FREE WORK AREA , QUIT @VA05247 01492000
  1749. SPACE 3 @VA05247 01493000
  1750. LTORG @VA05247 01494000
  1751. EJECT @VA05247 01495000
  1752. ***************************************************************@VA05247 01496000
  1753. * @VA05247 01497000
  1754. * STORAGE FIELDS PECULIAR TO 'DISK' PROCESSING... HRC003DS 01498490
  1755. * @VA05247 01499000
  1756. ***************************************************************@VA05247 01500000
  1757. SPACE 1 , HRC003DS 01500090
  1758. STRQMRK DC CL2'??' HRC003DS 01500180
  1759. STRMAX DC CL4'MAX ' HRC003DS 01500270
  1760. STRRW DC CL4'R/W ' HRC003DS 01500360
  1761. EJECT HRC003DS 01500450
  1762. ***************************************************************HRC003DS 01500540
  1763. * HRC003DS 01500630
  1764. * STORAGE FIELDS PECULIAR TO 'LIST' PROCESSING... HRC003DS 01500720
  1765. * HRC003DS 01500810
  1766. ***************************************************************HRC003DS 01500900
  1767. YES DC CL3'YES' @VA05247 01501000
  1768. NO DC CL3'NO' @VA05247 01502000
  1769. SEQNTL DC CL3'SEQ' @VA05247 01503000
  1770. PATTERN DC XL12'402020202020202020202020' @VA05247 01504000
  1771. ZDOS DC CL3'DOS' @VA05247 01505000
  1772. CMS DC CL3'CMS' @VA05247 01506000
  1773. THREE DC H'3' @VA05247 01507000
  1774. VSAM DC CL4'VSAM' @VA05247 01508000
  1775. MCAT DC CL8'IJSYSCT' VSAM MASTER CAT NAME @VA05247 01509000
  1776. PACKFLD DS D @VA05247 01510000
  1777. EDIT DC CL12' ' @VA05247 01511000
  1778. EXTENT DC CL8'EXTENT' @VA05247 01512000
  1779. MULT DC CL8'MULT' @VA05247 01513000
  1780. SPACE 1 @VA05247 01514000
  1781. MISCFLAG DC X'00' @VA05247 01515000
  1782. XEXTENT EQU X'80' ON IF 'EXTENT' DLBL LIST @VA05247 01516000
  1783. XMULT EQU X'40' ON IF 'MULT' DLBL LIST REQ @VA05247 01517000
  1784. XFOUND EQU X'20' ON IF SOME EXTNTS OR VOLS @VA05247 01518000
  1785. SPACE 1 @VA05247 01519000
  1786. SYSXXX DC CL8'SYS000' @VA05247 01520000
  1787. UNITTAB EQU * KEEP TABLE ENTRIES IN ORDER @VA05247 01521000
  1788. DC CL3'RDR' @VA05247 01522000
  1789. DC CL3'IPT' @VA05247 01523000
  1790. DC CL3'PCH' @VA05247 01524000
  1791. DC CL3'LST' @VA05247 01525000
  1792. DC CL3'LOG' @VA05247 01526000
  1793. DC CL3'LNK' @VA05247 01527000
  1794. DC CL3'RES' @VA05247 01528000
  1795. DC CL3'SLB' @VA05247 01529000
  1796. DC CL3'RLB' @VA05247 01530000
  1797. DC CL3'XXX' (FILLER) @VA05247 01531000
  1798. DC CL3'XXX' (FILLER) @VA05247 01532000
  1799. DC CL3'CLB' @VA05247 01533000
  1800. DC CL3'XXX' (FILLER) @VA05247 01534000
  1801. DC CL3'CAT' @VA05247 01535000
  1802. SPACE 1 @VA05247 01536000
  1803. * FOLLOWING ARE DISPLACEMENTS IN EXTENT, VOLUME TABLES @VA05247 01537000
  1804. DMODE EQU 0 DISK MODE (BOTH) @VA05247 01538000
  1805. DSYS EQU 1 SYS/PROG CODE (BOTH) @VA05247 01539000
  1806. DSYSCODE EQU 2 LOG UNIT CODE (BOTH) @VA05247 01540000
  1807. DEXTB EQU 3 BEGIN. EXTENT (EXT ONLY) @VA05247 01541000
  1808. DEXTE EQU 7 END EXTENT (EXT TAB ONLY) @VA05247 01542000
  1809. SPACE 1 @VA05247 01543000
  1810. BLANK EQU X'40' @VA05247 01544000
  1811. SAMDS EQU C'S' SEQ DATASET INDICATOR @VA05247 01545000
  1812. MULTLEN EQU 3 MULT TABLE ENTRY SIZE @VA05247 01546000
  1813. EXTLEN EQU 11 EXTENT TABLE ENTRY SIZE @VA05247 01547000
  1814. SYSLOG EQU 0 INDIC. SYSTEM LOGICAL UNIT @VA05247 01548000
  1815. PROG EQU 1 INDIC. PROGRAMMER LOG UNIT @VA05247 01549000
  1816. ONE EQU 1 @VA05247 01550000
  1817. EJECT @VA05247 01551000
  1818. LISTHEAD DS 0D ***DOSCB LIST HEADER*** @VA05247 01552000
  1819. DC C'DDNAME ' @VA05247 01553000
  1820. DC C'MODE ' @VA05247 01554000
  1821. DC C'LOGUNIT ' @VA05247 01555000
  1822. DC C'TYPE ' @VA05247 01556000
  1823. DC C'CATALOG ' @VA05247 01557000
  1824. DC C'EXT ' @VA05247 01558000
  1825. DC C'VOL ' @VA05247 01559000
  1826. DC C'BUFSPC ' @VA05247 01560000
  1827. DC C'PERM ' @VA05247 01561000
  1828. DC C'DISK ' @VA05247 01562000
  1829. DC C'DATASET.NAME' @VA05247 01563000
  1830. DS 0D @VA05247 01564000
  1831. HEADLEN EQU *-LISTHEAD @VA05247 01565000
  1832. SPACE 2 @VA05247 01566000
  1833. DOSCBLST DSECT @VA05247 01567000
  1834. DS 0D ***DOSCB LIST WORK AREA*** @VA05247 01568000
  1835. LDDNAME DS CL7 @VA05247 01569000
  1836. DS CL2 @VA05247 01570000
  1837. LMODE DS CL3 CMS DISK MODE OR 'DUM' @VA05247 01571000
  1838. DS CL1 @VA05247 01572000
  1839. LLOGUNIT DS CL3 ALWAYS 'SYS' @VA05247 01573000
  1840. LLOGXXX DS CL3 DOS LOGICAL UNIT CODE @VA05247 01574000
  1841. DS CL3 @VA05247 01575000
  1842. LTYPE DS CL4 'VSAM' OR 'SEQ' @VA05247 01576000
  1843. DS CL1 @VA05247 01577000
  1844. LCATALOG DS CL7 'IJSYSCT','IJSYSUC',ETC. @VA05247 01578000
  1845. DS CL1 @VA05247 01579000
  1846. LEXT DS CL2 NO. EXTENTS @VA05247 01580000
  1847. DS CL2 @VA05247 01581000
  1848. LVOL DS CL2 NO. VOLUMES @VA05247 01582000
  1849. DS CL2 @VA05247 01583000
  1850. LBUFSPC DS CL6 BUFFER SPACE SIZE @VA05247 01584000
  1851. DS CL2 @VA05247 01585000
  1852. LPERM DS CL3 'YES' OR 'NO' @VA05247 01586000
  1853. DS CL2 @VA05247 01587000
  1854. LDISK DS CL3 'CMS' OR 'DOS' @VA05247 01588000
  1855. DS CL2 @VA05247 01589000
  1856. LFILEID DS CL44 DATASET NAME @VA05247 01590000
  1857. ORG *-44 @VA05247 01591000
  1858. LFILENAM DS CL8 CMS FILENAME @VA05247 01592000
  1859. DS CL1 @VA05247 01593000
  1860. LFILETYP DS CL8 CMS FILETYPE @VA05247 01594000
  1861. ORG , @VA05247 01595000
  1862. DS 0D @VA05247 01596000
  1863. LSTLEND EQU (*-DOSCBLST)/8 LENGTH IN DWORDS @VA05247 01597000
  1864. EJECT @VA05247 01598000
  1865. EXTLIST DSECT @VA05247 01599000
  1866. DS 0D EXTENT, VOLUME INFO. @VA05247 01600000
  1867. EHDR DS 0CL22 @VA05247 01601000
  1868. EDDNAME DS CL7 DDNAME @VA05247 01602000
  1869. DS CL2 @VA05247 01603000
  1870. EMODE DS CL2 DISK MODE @VA05247 01604000
  1871. DS CL2 @VA05247 01605000
  1872. ELOGUNIT DS CL3 ALWAYS 'SYS' @VA05247 01606000
  1873. ELOGXXX DS CL3 LOGICAL UNIT CODE @VA05247 01607000
  1874. DS CL3 @VA05247 01608000
  1875. EEXTBEG DS CL10 BEGIN OF EXTENT @VA05247 01609000
  1876. EEXTEND DS CL10 END OF EXTENT @VA05247 01610000
  1877. DS 0D @VA05247 01611000
  1878. EXTLEND EQU (*-EXTLIST)/8 LENGTH IN DWORDS @VA05247 01612000
  1879. SPACE 1 @VA05247 01613000
  1880. DOSCB @VA05247 01614000
  1881. DMSQRY CSECT @VA05247 01615000
  1882. EJECT @VA05247 01616000
  1883. ABDSECT DSECT TO REFERENCE TABLES IN 'ABBREV @VA05247 01617000
  1884. * @VA05247 01618000
  1885. * TABLE GIVING WHEREABOUTS OF USER-DEFINED-ABBREVIATIONS@VA05247 01619000
  1886. * KEEP THE FOLLOWING SEVEN AD-CONS IN ORDER @VA05247 01620000
  1887. * @VA05247 01621000
  1888. USABRV DC F'0' NO. DBL-WORDS FREE-STORAGE IN USER-TABLE. 01622000
  1889. DC A(*-*) ADDRESS OF 1ST ITEM IN USER-ABRV-TABLE 01623000
  1890. DC F'17' (FOR BXLE) 01624000
  1891. DC A(*-*) ADDRESS OF LAST ITEM IN USER-ABRV-TABLE. 01625000
  1892. * 01626000
  1893. REGTABA DS A A(FIRSTAB):STANDARD SYNONYM TABLE 01627000
  1894. DC F'9' (FOR BXLE) 01628000
  1895. DS A A(LASTAB):END OF STANDARD SYNONYM TABLE 01629000
  1896. EJECT 01630000
  1897. SYSNAMES , @V305614 01631000
  1898. EJECT 01632000
  1899. NUCON 01633000
  1900. BGCOM 01634000
  1901. EXTSECT 01635000
  1902. REGEQU 01636000
  1903. CMSCB 01637000
  1904. FVS 01638000
  1905. EJECT 01639000
  1906. ADT 01640000
  1907. END 01641000