User Tools

Site Tools


ibm:vm370-lib:cms:dmsprv.assemble_src

DMSPRV Source

References

Source Listing

DMSPRV.ASSEMBLE.txt
  1. PRV TITLE 'DMSPRV (CMS) VM/370 - RELEASE 6' 00001000
  2. SPACE 2 00002000
  3. *. 00003000
  4. * MODULE NAME 00004000
  5. * 00005000
  6. * DMSPRV ( PSERV ) 00006000
  7. * 00007000
  8. * FUNCTION 00008000
  9. * 00009000
  10. * PROVIDE THE FACILITY TO COPY PROCEDURES IN THE 00010000
  11. * DOS/VS SYSTEM PROCEDURE LIBRARY TO A SPECIFIED 00011000
  12. * OUTPUT DEVICE. VALID OUTPUT DEVICES ARE VIRTUAL 00012000
  13. * PRINTER, CMS DISK FILE, USER'S CONSOLE, AND/OR 00013000
  14. * VIRTUAL PUNCH. 00014000
  15. * 00015000
  16. * ATTRIBUTES 00016000
  17. * 00017000
  18. * DISK RESIDENT MODULE 00018000
  19. * EXECUTES IN USER AREA 00019000
  20. * 00020000
  21. * ENTRY POINTS 00021000
  22. * 00022000
  23. * DMSPRV 00023000
  24. * 00024000
  25. * ENTRY CONDITIONS 00025000
  26. * 00026000
  27. * R1 = PARAMETER LIST 00027000
  28. * 00028000
  29. * DC CL8'PSERV' COMMAND 00029000
  30. * DC CL8'FNAME' NAME OF PROCEDURE TO COPY 00030000
  31. * DC CL8'FTYPE' FILETYPE OF CMS DISK FILE 00031000
  32. * ... ( ONLY APPLICABLE FOR DISK ) 00032000
  33. * ... ( DEFAULTS TO PROC ) 00033000
  34. * DC CL8'(' BEGIN OF OPTIONS IF ANY 00034000
  35. * DC CL8'TERM'|'DISK'|'PRINT'|'PUNCH' ..OPTIONS.. 00035000
  36. * 00036000
  37. * OPTIONS 00037000
  38. * 00038000
  39. * TERM - DIRECT PROCEDURE FILE TO USER'S CONSOLE 00039000
  40. * DISK - DIRECT PROCEDURE FILE TO USER'S 'A' DISK 00040000
  41. * - DISK IS DEFAULT ('FN' PROC A1) 00041000
  42. * PRINT - DIRECT PROCEDURE FILE TO SPOOLED PRINTER 00042000
  43. * PUNCH - DIRECT PROCEDURE FILE TO SPOOLED PUNCH 00043000
  44. * 00044000
  45. * EXIT CONDITIONS 00045000
  46. * 00046000
  47. * RETURN TO CALLER WITH RETURN CODE IN R15 00047000
  48. * 00048000
  49. * RETURN CODES AND MESSAGES: 00049000
  50. * 00050000
  51. * 24 - NO PROCEDURE NAME SPECIFIED 00051000
  52. * 24 - INVALID OPTION SPECIFIED 00052000
  53. * 24 - INVALID PARAMETER SPECIFIED 00053000
  54. * 28 - SPECIFIED PROCEDURE FILE NOT FOUND 00054000
  55. * 32 - CMS/DOS ENVIRONMENT NOT ACTIVE 00055000
  56. * 36 - NO READ/WRITE 'A' DISK ACCESSED 00056000
  57. * 36 - NO SYSRES VOLUME ACTIVE 00057000
  58. * 100 - SPECIFIED DISK IS NOT ATTACHED 00058000
  59. * 100 - INPUT ERROR ON SYSRES OR SYSRLB 00059000
  60. * 100 - ERROR WRITING FILE TO DISK 00060000
  61. * 00061000
  62. * CALLS TO OTHER ROUTINES 00062000
  63. * 00063000
  64. * DMSERR, DMSERS, DMSKEY, DMKGIO, DMSPIO 00064000
  65. * DMSBWR, DMSCWR, DMSCIO, DMSCPF, DMSFNS 00065000
  66. * 00066000
  67. * EXTERNAL REFERENCES 00067000
  68. * 00068000
  69. * NUCON, BGCOM, MAPPUB 00069000
  70. * 00070000
  71. * TABLES/WORK AREAS 00071000
  72. * 00072000
  73. * NONE 00073000
  74. * 00074000
  75. * REGISTER USAGE 00075000
  76. * 00076000
  77. * R0 NUCON ADDRESSABILITY & WORK 00077000
  78. * R1 COMMAND LINE POINTER & PLIST(S) POINTER 00078000
  79. * R2 DIRECTORY BUFFER POINTER & WORK 00079000
  80. * R3 WORK 00080000
  81. * R4 NOT USED 00081000
  82. * R5 NOT USED 00082000
  83. * R6 NOT USED 00083000
  84. * R7 NOT USED 00084000
  85. * R8 NOT USED 00085000
  86. * R9 NOT USED 00086000
  87. * R10 INTERNAL LINKAGE 00087000
  88. * R11 NOT USED 00088000
  89. * R12 DMSPRV ADDRESSABILITY 00089000
  90. * R13 NOT USED 00090000
  91. * R14 EXTERNAL LINKAGE 00091000
  92. * R15 ADDRESS LINKING ROUTINE & RETURN CODE 00092000
  93. * 00093000
  94. * OPERATION 00094000
  95. * 00095000
  96. * 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00096000
  97. * THE RETURN REGISTER. ACQUIRE SUPERVISOR KEY 00097000
  98. * AND INITIALIZE REUSABILITY FIELDS. VERIFY IF 00098000
  99. * IN CMS/DOS ENVIRONMENT. 00099000
  100. * 00100000
  101. * 2. CHECK THE COMMAND LINE FOR VALID ARGUMENTS 00101000
  102. * AND OPTIONS. ENSURE THAT A PROC. NAME WAS 00102000
  103. * SPECIFIED. SET APPROPIATE SWITCHES FOR EACH 00103000
  104. * OPTION SPECIFIED. IF THE 'DISK' OPTION IS 00104000
  105. * SPECIFIED OR IMPLIED, ERASE ANY OLD FILE ON 00105000
  106. * THE 'A' DISK. IF ERASE RETURNS A CODE OF 36, 00106000
  107. * EITHER THE 'A' DISK IS R/O OR IS NOT ATTACHED. 00107000
  108. * 00108000
  109. * 3. DETERMINE IF THE SYSTEM PROCEDURE LIBRARY IS 00109000
  110. * ACTIVE (IF IT EXISTS) AND START READING THE 00110000
  111. * APPROPIATE LIBRARY DIRECTORY RECORDS TO FIND 00111000
  112. * THE SPECIFIED PROCEDURE. ONCE THE PROCEDURE 00112000
  113. * ENTRY IS FOUND, COMPUTE THE DISK ADDRESS OF 00113000
  114. * THE PROCEDURE DATA BLOCKS. 00114000
  115. * 00115000
  116. * 4. READ THE PROCEDURE DATA BLOCKS ONE AT A TIME. 00116000
  117. * DECODE EACH DATA BLOCK INTO CARD IMAGES, AND 00117000
  118. * WRITE EACH CARD IMAGE ( AS IS ) TO THE OUTPUT 00118000
  119. * DEVICE. 00119000
  120. * 00120000
  121. * 5. WHEN ALL PROCESSING HAS BEEN DONE, ALL OUTPUT 00121000
  122. * DEVICES ARE CLOSED. 00122000
  123. * 00123000
  124. * 6. A SWITCH TO PROBLEM PROGRAM KEY IS DONE, AND A 00124000
  125. * RETURN TO THE CALLER IS MADE PASSING IN REG. 15 00125000
  126. * THE RETURN CODE OF THE COMMAND. 00126000
  127. *. 00127000
  128. EJECT 00128000
  129. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00129000
  130. * * 00130000
  131. * INITIALIZATION... ESTABLISH BASE REG. AND SAVE RETURN. * 00131000
  132. * VERIFY CMS/DOS ENVIRONMENT ACTIVE * 00132000
  133. * * 00133000
  134. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00134000
  135. SPACE 2 00135000
  136. DMSPRV CSECT @V305001 00136000
  137. USING DMSPRV,R12 @V305001 00137000
  138. USING NUCON,R0 @V305001 00138000
  139. LR R12,R15 ESTABLISH BASE @V305001 00139000
  140. ST R14,SAVE14 SAVE RETURN REGISTER @V305001 00140000
  141. DMSKEY NUCLEUS @V305001 00141000
  142. TM DOSFLAGS,DOSMODE IN CMS/DOS MODE ? @V305001 00142000
  143. BZ ERR099 NO, ERROR @V305001 00143000
  144. XC SSW,SSW CLEAR INTERNAL SWITCH @V305001 00144000
  145. MVC FTYPE,PROC SET DEFAULT FILE TYPE @V305001 00145000
  146. EJECT 00146000
  147. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00147000
  148. * * 00148000
  149. * CHECK COMMAND LINE FOR VALID ARGUMENTS AND OPTIONS. * 00149000
  150. * SET APROPIATE SWITCHES FOR EACH OPTION SPECIFIED. * 00150000
  151. * IF NO OPTIONS SPECIFIED, 'DISK' IS DEFAULT. * 00151000
  152. * * 00152000
  153. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00153000
  154. SPACE 2 00154000
  155. LA R1,8(,R1) BUMP TO PROCEDURE NAME @V305001 00155000
  156. CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00156000
  157. BE ERR001 NO, ERROR @V305001 00157000
  158. CLI 0(R1),LPAR DITTO ? @V305001 00158000
  159. BE ERR001 NO, ERROR @V305001 00159000
  160. MVC PCNAME,0(R1) SAVE PROCEDURE NAME @V305001 00160000
  161. LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00161000
  162. CLI 0(R1),FENCE ANY MORE ON LINE ? @V305001 00162000
  163. BE OPTSOK NO, BRANCH @V305001 00163000
  164. CLI 0(R1),LPAR LEFT PARENS ? @V305001 00164000
  165. BE OPTLUP YES, PROCESS OPTIONS @V305001 00165000
  166. MVC FTYPE,0(R1) SET USER'S FILE TYPE @V305001 00166000
  167. LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00167000
  168. CLI 0(R1),FENCE ANY MORE ? @V305001 00168000
  169. BE OPTSOK NO, BRANCH @V305001 00169000
  170. CLI 0(R1),LPAR LEFT PARENS ? @V305001 00170000
  171. BNE ERR070 NO, ERROR @V305001 00171000
  172. OPTLUP LA R1,8(,R1) BUMP TO OPTION @V305001 00172000
  173. CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00173000
  174. BE OPTSOK NO, ALL DONE WITH OPTIONS @V305001 00174000
  175. CLI 0(R1),RPAR END OF OPTIONS ? @V305001 00175000
  176. BE OPTSOK YES, ALL DONE WITH OPTIONS @V305001 00176000
  177. CLC CDISK,0(R1) DISK OPTION ? @V305001 00177000
  178. BNE CKPRT NO, CHECK PRINT @V305001 00178000
  179. OI SSW,DISK SET DISK FLAG @V305001 00179000
  180. B OPTLUP KEEP LOOKING @V305001 00180000
  181. CKPRT CLC CPRINT,0(R1) PRINT OPTION ? @V305001 00181000
  182. BNE CKPUN NO, CHECK PUNCH @V305001 00182000
  183. OI SSW,PRINT SET PRINT FLAG @V305001 00183000
  184. B OPTLUP KEEP LOOKING @V305001 00184000
  185. CKPUN CLC CPUNCH,0(R1) PUNCH OPTION ? @V305001 00185000
  186. BNE CKTRM NO, CHECK TERM @V305001 00186000
  187. OI SSW,PUNCH SET PUNCH FLAG @V305001 00187000
  188. B OPTLUP KEEP LOOKING @V305001 00188000
  189. CKTRM CLC CTERM,0(R1) TERM OPTION ? @V305001 00189000
  190. BNE ERR003 NO, ERROR @V305001 00190000
  191. OI SSW,TERM SET TERM FLAG @V305001 00191000
  192. B OPTLUP KEEP LOOKING @V305001 00192000
  193. EJECT 00193000
  194. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00194000
  195. * * 00195000
  196. * IF 'DISK' OPTION SPECIFIED OR IMPLIED, ERASE ANY OLD * 00196000
  197. * FILE ON THE 'A' DISK WITH THE SAME FILEID. IF ERASE * 00197000
  198. * RETURNS A CODE OF 36, EITHER THE 'A' DISK IS R/O OR IS * 00198000
  199. * NOT ATTACHED. IN EITHER CASE A MESSAGE IS ISSUED. * 00199000
  200. * * 00200000
  201. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00201000
  202. SPACE 2 00202000
  203. OPTSOK CLI SSW,ZERO ANY OPTIONS SPECIFIED? @VA09217 00203000
  204. BNE READDIR NOT DEFAULT - GO CHECK DIRECTORY @VA09217 00203600
  205. OI SSW,DISK TURN ON DISK OPTION @VA09217 00204200
  206. B READDIR GO CHECK DIRECTORY @VA09217 00204800
  207. CHKDSK EQU * @VA09217 00205400
  208. TM SSW,DISK WAS DISK SPECIFIED? @VA09217 00206000
  209. BZ FNDENT NOT DISK - DONT BOTHER TO ERASE @VA09217 00206600
  210. ERSOLD MVC FNAME,PCNAME SET UP FILENAME @VA09217 00207200
  211. LA R1,DSKLST GET ERASE PLIST @V305001 00208000
  212. L R15,AERASE GET DMSERS ADDRESS @V305001 00209000
  213. BALR R14,R15 ERASE OLD FILE @V305001 00210000
  214. CH R15,=H'36' ANY DISK PROBLEM ? @V305001 00211000
  215. BE ERR006 YES,GIVE ERROR @VA09217 00212000
  216. B FNDENT CONTINUE @VA09217 00213000
  217. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00214000
  218. * * 00215000
  219. * DETERMINE IF READING FROM SYSTEM PROCEDURE LIBRARY * 00216000
  220. * AND READ LIBRARY DIRECTORY TO INITIATE SEARCH FOR * 00217000
  221. * SPECIFIED PROCEDURE. ONCE THE PROCEDURE ENTRY IS * 00218000
  222. * FOUND, COMPUTE THE DISK ADDRESS OF THE PROCEDURE * 00219000
  223. * DATA BLOCKS. * 00220000
  224. * * 00221000
  225. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00222000
  226. SPACE 2 00223000
  227. READDIR LA R3,SYSRES GET SYSRES LUB INDEX @V305001 00224000
  228. L R1,ASYSREF GET BGCOM ADDRESS @V305001 00225000
  229. USING BGCOM,R1 @V305001 00226000
  230. AH R3,LUBPT POINT TO CORRECT LUB ENTRY @V305001 00227000
  231. TM 0(R3),UNASSGN UNIT ASSIGNED ? @V305001 00228000
  232. BO ERR097 NO, ERROR @V305001 00229000
  233. LH R3,0(,R3) LUB ENTRY TO REG 3 @V305001 00230000
  234. SRL R3,8 ISOLATE PUB POINTER @V305001 00231000
  235. SLL R3,3 MULTIPLY BY 8 @V305001 00232000
  236. AH R3,PUBPT POINT TO CORRECT PUB ENTRY @V305001 00233000
  237. USING PUBADR,R3 @V305001 00234000
  238. MVC CUU,PUBCUU SAVE SYSRES DEVICE ADDRESS @V305001 00235000
  239. DROP R1,R3 @V305001 00236000
  240. MVC CCHHR(5),SPRDIR SET TO FIND SPR DIRECTORY @V305001 00237000
  241. BAL R10,DISKIO GO READ POINTER TO SPR @V305001 00238000
  242. MVC SPRADR(5),BUFFER+2 SET SPR DIRECTORY ADDR. @V305001 00239000
  243. CLC SPRADR(5),ZEROS PROC. LIBRARY AVAILABLE ? @V305001 00240000
  244. BE ERR002 NO, ERROR @V305001 00241000
  245. MVC CCHHR(5),SPRADR SET UP SEEK/SEARCH ADDRESS @V305001 00242000
  246. LA R3,DIRBL DIRECTORY BLOCK LENGTH @V305001 00243000
  247. STH R3,READCCW+6 TO READ CCW @V305001 00244000
  248. NXTBLK BAL R10,DISKIO READ DIRECTORY @V305001 00245000
  249. LA R2,BUFFER POINT TO BUFFER @V305001 00246000
  250. TM SSW,PASS1 1ST. TIME HERE ? @V305001 00247000
  251. BO TSTEND NO, BRANCH @V305001 00248000
  252. LA R2,80(,R2) BUMP PAST DIRECTORY @V305001 00249000
  253. OI SSW,PASS1 SET 1ST. TIME SWITCH @V305001 00250000
  254. TSTEND CLI 0(R2),DIREND END OF DIRECTORY ? @V305001 00251000
  255. BE ERR002 YES, PROCEDURE NOT FOUND @V305001 00252000
  256. CLI 0(R2),ZERO END OF BLOCK ? @V305001 00253000
  257. BE NXTBLK YES, GET ANOTHER BLOCK @V305001 00254000
  258. CLC PCNAME,0(R2) PROC NAME MATCH ? @VA09217 00255000
  259. BE CHKDSK FOUND - GO CHECK FOR ERASE @VA09217 00256000
  260. LA R2,16(,R2) BUMP TO NEXT ENTRY @VA09217 00257000
  261. B TSTEND KEEP LOOKING @V305001 00258000
  262. EJECT 00259000
  263. FNDENT SR R3,R3 CLEAR REGISTER @V305001 00260000
  264. ICM R3,M8,11(R2) GET C1 AND H2 INTO HI-ORDER @V305001 00261000
  265. SRL R3,6 PLACE C1 PROPERLY @V305001 00262000
  266. STCM R3,M14,CCHHR SAVE FOR NOW @V305001 00263000
  267. MVC CHHR(1),10(R2) NOW MOVE C2 @V305001 00264000
  268. MVC HR(2),11(R2) NOW MOVE H2 AND R @V305001 00265000
  269. NI HR,CLRH2 CLEAR 2 HI-BITS H2 @V305001 00266000
  270. LA R3,BLKLN GET PROC DATA BLOCKS LENGTH @V305001 00267000
  271. STH R3,READCCW+6 SAVE IN READ CCW @V305001 00268000
  272. SPACE 2 00269000
  273. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00270000
  274. * * 00271000
  275. * READ A DATA BLOCK AND OUTPUT THE RECORD. * 00272000
  276. * END OF PROCEDURE IS DETERMINED BY A '/+' IN COLS. * 00273000
  277. * 1-2 OF THE LAST RECORD. * 00274000
  278. * * 00275000
  279. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00276000
  280. SPACE 2 00277000
  281. NXTBUF BAL R10,DISKIO READ 1ST DATA BLOCK @V305001 00278000
  282. BAL R10,OUTLINE GO OUTPUT THIS LINE @V305001 00279000
  283. CLC EOPR,BUFFER END OF PROCEDURE ? @V305001 00280000
  284. BE ALLDONE YES, EXIT @V305001 00281000
  285. B NXTBUF GO GET NEXT RECORD @V305001 00282000
  286. EJECT 00283000
  287. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00284000
  288. * * 00285000
  289. * ROUTINE TO READ FROM SYSTEM PROCEDURE LIBRARY. * 00286000
  290. * THE I/O IS DIAGNOSED TO CP AND UPON RETURN ONLY * 00287000
  291. * END-OF-CYLINDER IS ACCEPTED. ANY OTHER ERROR WILL * 00288000
  292. * TERMINATE THIS COMMAND. * 00289000
  293. * * 00290000
  294. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00291000
  295. SPACE 2 00292000
  296. DISKIO LA R0,SEEKCCW GET CHANNEL PGM ADDR @V305001 00293000
  297. LH R1,CUU GET DISK DEVICE ADDR @V305001 00294000
  298. DC X'83100020' DIAGNOSE I/O TO CP @V305001 00295000
  299. BZR R10 RETURN WITH GOOD I/O @V305001 00296000
  300. BM ERR113 DISK NOT ATTACHED EXIT @V305001 00297000
  301. BP ERR411 I/O ERROR @V305066 00298000
  302. STH R0,SENSE SAVE SENSE INFO. @V305001 00299000
  303. TM SENSE+1,EOC IS IT END-OF-CYLINDER @V305001 00300000
  304. BZ ERR411 NO, UNRECOVERABLE ERROR @V305066 00301000
  305. LH R1,CCHHR GET CURRENT CYLINDER @V305001 00302000
  306. LA R1,1(,R1) UP BY ONE @V305001 00303000
  307. STH R1,CCHHR SAVE NEW CYLINDER @V305001 00304000
  308. LA R1,ONE GET HEAD 0, REC 1 CONSTANT @V305001 00305000
  309. STCM R1,M7,HHR SAVE NEW HEAD AND REC @V305001 00306000
  310. BR R10 RETURN TO CALLER @V305001 00307000
  311. EJECT 00308000
  312. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00309000
  313. * * 00310000
  314. * ROUTINE TO DETERMINE TO WHAT DEVICE OR DEVICES THE * 00311000
  315. * OUTPUT SHOULD GO. SWITCH 'SSW' CONTAINS INFORMATION * 00312000
  316. * TO DETERMINE THIS. ALL I/O IS DONE THROUGH CMS FUNCTIONS. * 00313000
  317. * * 00314000
  318. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00315000
  319. SPACE 2 00316000
  320. OUTLINE TM SSW,DISK+PRINT+PUNCH+TERM ANY OPTIONS ? @V305001 00317000
  321. BZ OUTDSK NO, DEFAULT TO DISK @V305001 00318000
  322. TM SSW,PUNCH PUNCH SPECIFIED ? @V305001 00319000
  323. BZ TSTPRT NO, CHECK PRINT @V305001 00320000
  324. LA R1,PUNLST POINT TO PUNCH PLIST @V305001 00321000
  325. SVC 202 PUNCH THIS CARD @V305001 00322000
  326. DC AL4(*+4) ... @V305001 00323000
  327. CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00324000
  328. BE EXIT YES, GET OUT @V305001 00325000
  329. SPACE 1 00326000
  330. TSTPRT TM SSW,PRINT PRINT SPECIFIED ? @V305001 00327000
  331. BZ TSTCON NO, CHECK TERM @V305001 00328000
  332. PRT LA R1,PRTLST POINTER TO PRINT PLIST @V305066 00329000
  333. SVC 202 PRINT THIS CARD @V305001 00330000
  334. DC AL4(*+4) ... @V305001 00331000
  335. CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00332000
  336. BE EXIT YES, GET OUT @V305001 00333000
  337. TM SSW,FIRST FIRST TIME FLAG ON? @V305066 00334000
  338. BO TSTCON NO @V305066 00335000
  339. OI SSW,FIRST FIRST TIME INDICATOR @V305066 00336000
  340. MVI CHAR,BLANK CONTROL CHAR @V305066 00337000
  341. B PRT GO TO PRINT @V305066 00338000
  342. SPACE 1 00339000
  343. TSTCON TM SSW,TERM TERM SPECIFIED ? @V305001 00340000
  344. BZ TSTDSK NO, CHECK DISK @V305001 00341000
  345. LA R1,TYPLST POINT TO TERM PLIST @V305001 00342000
  346. SVC 202 DISPLAY THIS LINE @V305001 00343000
  347. SPACE 1 00344000
  348. TSTDSK TM SSW,DISK DISK SPECIFIED ? @V305001 00345000
  349. BZR R10 NO, RETURN @V305001 00346000
  350. OUTDSK LA R1,DSKLST POINT TO DISK PLIST @V305001 00347000
  351. L R15,AWRBUF GET DMSBWR ADDRESS @V305001 00348000
  352. BALR R14,R15 WRITE THIS RECORD @V305001 00349000
  353. LTR R15,R15 ANY ERRORS ? @V305001 00350000
  354. BNZ ERR105 YES, BRANCH @V305001 00351000
  355. BR R10 @V305001 00352000
  356. EJECT 00353000
  357. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00354000
  358. * * 00355000
  359. * CLOSE ANY OUTPUT FILE USED BY THIS COMMAND, THEN * 00356000
  360. * RETURN BACK TO CALLER PASSING IN REGISTER 15 THE * 00357000
  361. * RETURN CODE OF THIS COMMAND. * 00358000
  362. * * 00359000
  363. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00360000
  364. SPACE 2 00361000
  365. ALLDONE SR R15,R15 ZERO RETURN CODE @V305001 00362000
  366. EXIT LR R10,R15 TEMP SAVE RETURN CODE @V305001 00363000
  367. TM SSW,DISK+PRINT+PUNCH+TERM ANY OPTIONS ? @V305001 00364000
  368. BZ CLDSK2 NO, CLOSE DISK FILE @V305001 00365000
  369. TM SSW,PRINT PRINT OPTION ? @V305001 00366000
  370. BZ CLPUN NO, CHECK PUNCH @V305001 00367000
  371. MVC CLDEV,CPRINT SET UP DEVICE @V305001 00368000
  372. LA R1,CLOSE GET CLOSE PLIST @V305001 00369000
  373. SVC 202 CLOSE PRINTER @V305001 00370000
  374. DC AL4(*+4) NO-OP @V305001 00371000
  375. CLPUN TM SSW,PUNCH PUNCH OPTION ? @V305001 00372000
  376. BZ CLDSK NO, CHECK DISK @V305001 00373000
  377. MVC CLDEV,CPUNCH SET UP DEVICE @V305001 00374000
  378. LA R1,CLOSE GET CLOSE PLIST @V305001 00375000
  379. SVC 202 CLOSE PUNCH @V305001 00376000
  380. DC AL4(*+4) NO-OP @V305001 00377000
  381. CLDSK TM SSW,DISK DISK OPTION ? @V305001 00378000
  382. BZ EXIT2 NO, RETURN @V305001 00379000
  383. CLDSK2 LA R1,DSKLST GET FINIS PLIST @V305001 00380000
  384. L R15,AFINIS GET DMSFNS ADDRESS @V305001 00381000
  385. BALR R14,R15 CLOSE OUTPUT FILE @V305001 00382000
  386. EXIT2 L R14,SAVE14 LOAD RETURN REGISTER @V305001 00383000
  387. DMSKEY RESET @V305001 00384000
  388. LR R15,R10 RESTORE RETURN CODE @V305001 00385000
  389. BR R14 RETURN TO CALLER @V305001 00386000
  390. EJECT 00387000
  391. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00388000
  392. * * 00389000
  393. * STORAGE AND CONSTANT AREAS * 00390000
  394. * * 00391000
  395. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00392000
  396. SPACE 2 00393000
  397. ZEROS DC D'0' CONSTANT OF ZEROS @V305001 00394000
  398. SAVE14 DS F SAVE FOR RETURN REGISTER @V305001 00395000
  399. SPRADR DC 3H'0' ADDRESS OF SYS PROC DIRECTORY @V305001 00396000
  400. SPRDIR DC H'0',H'1',X'4' POINTER TO SYS PROC DIRECTORY @V305001 00397000
  401. SSW DS X INTERNAL SWITCH @V305001 00398000
  402. CUU DS H SYSRES DISK ADDRESS @V305001 00399000
  403. SENSE DS H SENSE INFO. FROM BAD DIAGNOSE @V305001 00400000
  404. EOPR DC CL2'/+' END OF PROCEDURE INDICATOR @V305001 00401000
  405. CDISK DC CL8'DISK' DISK OPTION @V305001 00402000
  406. CPRINT DC CL8'PRINT' PRINT OPTION @V305001 00403000
  407. CPUNCH DC CL8'PUNCH' PUNCH OPTION @V305001 00404000
  408. CTERM DC CL8'TERM' TERM OPTION @V305001 00405000
  409. PROC DC CL8'PROC' DEFAULT FILE TYPE @V305001 00406000
  410. PCNAME DC CL8' ' PROCEDURE NAME @V305001 00407000
  411. DS 0H @V305001 00408000
  412. BBCCHHR DC H'0' SEEK ADDRESS @V305001 00409000
  413. CCHHR DS X SEARCH ADDRESS @V305001 00410000
  414. CHHR DS X ... @V305001 00411000
  415. HHR DS X ... @V305001 00412000
  416. HR DS X ... @V305001 00413000
  417. R DS X ... @V305001 00414000
  418. DS XL3 ... @V305001 00415000
  419. EJECT 00416000
  420. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00417000
  421. * * 00418000
  422. * CHANNEL PROGRAMS AND COMMON EQUATES * 00419000
  423. * * 00420000
  424. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00421000
  425. SPACE 2 00422000
  426. SEEKCCW CCW SEEK,BBCCHHR,CC+SLI,6 @V305001 00423000
  427. SRCHCCW CCW SEARCH,CCHHR,CC+SLI,5 @V305001 00424000
  428. CCW TIC,SRCHCCW,0,1 @V305001 00425000
  429. READCCW CCW RDDATA,BUFFER,CC,80 @V305001 00426000
  430. CCW RDCOUNT,CCHHR,SLI,8 @V305001 00427000
  431. * 00428000
  432. SEEK EQU X'07' SEEK CCW CODE @V305001 00429000
  433. SEARCH EQU X'31' SEARCH CCW CODE @V305001 00430000
  434. TIC EQU X'08' TIC CCW CODE @V305001 00431000
  435. RDDATA EQU X'06' READ DATA CCW CODE @V305001 00432000
  436. RDCOUNT EQU X'92' READ COUNT MT CCW CODE @V305001 00433000
  437. CC EQU X'40' COMMAND CHAIN FLAG @V305001 00434000
  438. SLI EQU X'20' SUPPRESS I.L. FLAG @V305001 00435000
  439. FENCE EQU X'FF' PLIST FENCE CODE @V305001 00436000
  440. LPAR EQU C'(' LEFT PARENS CODE @V305001 00437000
  441. RPAR EQU C')' RIGHT PARENS CODE @V305001 00438000
  442. BLANK EQU C' ' BLANK CHARACTER CODE @V305001 00439000
  443. SYSRES EQU 12 SYSRES LUB INDEX @V305001 00440000
  444. EOC EQU X'20' END OF CYLINDER @V305001 00441000
  445. BLKLN EQU 80 PROCEDURE BLOCK LENGTH @V305001 00442000
  446. UNASSGN EQU X'FE' LOGICAL UNIT UNASSIGNED @V305001 00443000
  447. DIREND EQU C'*' DIRECTORY BLOCK END CODE @V305001 00444000
  448. DIRBL EQU 160 DIRECTORY BLOCK LENGTH @V305001 00445000
  449. CLRH2 EQU X'3F' MASK TO CLEAR 2 HI BITS HEAD2 @V305001 00446000
  450. ZERO EQU 0 CONSTANT @V305001 00447000
  451. ONE EQU 1 CONSTANT @V305001 00448000
  452. M7 EQU B'0111' ICM/STCM MASK @V305001 00449000
  453. M8 EQU B'1000' ICM/STCM MASK @V305001 00450000
  454. M14 EQU B'1110' ICM/STCM MASK @V305001 00451000
  455. RC24 EQU 24 RETURN CODE @V305001 00452000
  456. RC28 EQU 28 RETURN CODE @V305001 00453000
  457. RC36 EQU 36 RETURN CODE @V305001 00454000
  458. RC40 EQU 40 RETURN CODE @V305001 00455000
  459. RC100 EQU 100 RETURN CODE @V305001 00456000
  460. * 00457000
  461. * FLAGS FOR INTERNAL SWITCH 'SSW' 00458000
  462. * 00459000
  463. DISK EQU X'80' DISK OUTPUT @V305001 00460000
  464. PRINT EQU X'40' PRINT OUTPUT @V305001 00461000
  465. PUNCH EQU X'20' PUNCH OUTPUT @V305001 00462000
  466. TERM EQU X'10' TERM OUTPUT @V305001 00463000
  467. PASS1 EQU X'08' DIRECTORY BY-PASS FLAG @V305001 00464000
  468. FIRST EQU X'04' FIRST TIME SWITCH @V305066 00465000
  469. EJECT 00466000
  470. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00467000
  471. * * 00468000
  472. * BUFFERS AND CMS FUNCTION'S PLISTS * 00469000
  473. * * 00470000
  474. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00471000
  475. SPACE 2 00472000
  476. DS 0F @V305001 00473000
  477. DC C' ' @V305066 00474000
  478. CHAR DC X'8B' EJECT ON FIRST PRINT @V305066 00475000
  479. BUFFER DS CL160 WORK BUFFER @V305001 00476000
  480. SPACE 2 00477000
  481. DS 0D @V305001 00478000
  482. PUNLST DC CL8'CARDPH' COMMAND NAME @V305001 00479000
  483. DC AL4(BUFFER) BUFFER ADDRESS @V305001 00480000
  484. DC AL4(80) BUFFER LENGTH @V305001 00481000
  485. SPACE 1 00482000
  486. PRTLST DC CL8'PRINTR' COMMAND NAME @V305001 00483000
  487. DC AL4(BUFFER-1) BUFFER ADDRESS @V305001 00484000
  488. FLAG DC H'1',H'81' FLAG AND BUFFER LENGTH @V305066 00485000
  489. DC 8X'FF' FENCE @V305001 00486000
  490. SPACE 1 00487000
  491. DS 0D @V305001 00488000
  492. TYPLST DC CL8'TYPLIN' COMMAND NAME @V305001 00489000
  493. DC AL1(1) FLAG @V305001 00490000
  494. DC AL3(BUFFER) BUFFER ADDRESS @V305001 00491000
  495. DC CL1'B' FLAG @V305001 00492000
  496. DC AL3(80) BUFFER LENGTH @V305001 00493000
  497. SPACE 1 00494000
  498. DS 0D @V305001 00495000
  499. DSKLST DC CL8' ' COMMAND NAME @V305001 00496000
  500. FNAME DC CL8' ' FILE NAME @V305001 00497000
  501. FTYPE DC CL8' ' FILE TYPE @V305001 00498000
  502. DC CL2'A1' FILE MODE @V305001 00499000
  503. DC H'0' ITEM NUMBER @V305001 00500000
  504. DC A(BUFFER) BUFFER ADDRESS @V305001 00501000
  505. DC A(80) BUFFER LENGTH @V305001 00502000
  506. DC CL2'F' F/V FLAG @V305001 00503000
  507. DC H'1' NUMBER OF ITEMS @V305001 00504000
  508. SPACE 1 00505000
  509. DS 0D @V305001 00506000
  510. CLOSE DC CL8'CP' COMMAND NAME @V305001 00507000
  511. DC CL8'CLOSE' ACTION @V305001 00508000
  512. CLDEV DC CL8' ' DEVICE TO CLOSE @V305001 00509000
  513. DC 8X'FF' PLIST FENCE @V305001 00510000
  514. EJECT 00511000
  515. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00512000
  516. * * 00513000
  517. * ERROR MESSAGES * 00514000
  518. * * 00515000
  519. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00516000
  520. SPACE 2 00517000
  521. ERR001 EQU * @V305001 00518000
  522. DMSERR TEXT='NO PROCEDURE NAME SPECIFIED',NUM=98,LET=E 00519000
  523. LA R15,RC24 RETURN CODE @V305001 00520000
  524. B EXIT GET OUT @V305001 00521000
  525. SPACE 1 00522000
  526. ERR002 LA R2,PCNAME POINT TO PROCEDURE NAME @V305001 00523000
  527. DMSERR TEXT='PROCEDURE ''........'' NOT FOUND',NUM=4,LET=E, *00524000
  528. SUB=(CHARA,(R2)) @V305001 00525000
  529. LA R15,RC28 RETURN CODE @V305001 00526000
  530. B EXIT GET OUT @V305001 00527000
  531. EJECT 00528000
  532. ERR003 LR R2,R1 POINT TO OPTION @V305001 00529000
  533. DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, *00530000
  534. SUB=(CHARA,(R2)) @V305001 00531000
  535. LA R15,RC24 RETURN CODE @V305001 00532000
  536. B EXIT GET OUT @V305001 00533000
  537. SPACE 1 00534000
  538. ERR006 EQU * @V305001 00535000
  539. DMSERR TEXT='NO READ/WRITE ''A'' DISK ACCESSED',NUM=6,LET=E 00536000
  540. LA R15,RC36 RETURN CODE @V305001 00537000
  541. B EXIT GET OUT @V305001 00538000
  542. EJECT 00539000
  543. ERR070 LR R2,R1 POINT TO PARAMETER @V305001 00540000
  544. DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70,LET=E, *00541000
  545. SUB=(CHARA,(R2)) @V305001 00542000
  546. LA R15,RC24 RETURN CODE @V305001 00543000
  547. B EXIT GET OUT @V305001 00544000
  548. SPACE 1 00545000
  549. ERR113 LH R2,CUU GET DISK ADDRESS @V305001 00546000
  550. DMSERR TEXT='DISK (....) NOT ATTACHED',NUM=113,LET=S, @V305001*00547000
  551. SUB=(HEX,(R2)) @V305001 00548000
  552. LA R15,RC100 RETURN CODE @V305001 00549000
  553. B EXIT GET OUT @V305001 00550000
  554. EJECT 00551000
  555. ERR411 LR R2,R15 I/O ERROR CODE @V305066 00552000
  556. DMSERR TEXT='INPUT ERROR CODE ''..'' ON ''SYSRES''',NUM=411, *00553000
  557. LET=S,SUB=(DEC,(R2)) @V305001 00554000
  558. LA R15,RC100 RETURN CODE @V305001 00555000
  559. B EXIT GET OUT @V305001 00556000
  560. SPACE 1 00557000
  561. ERR099 EQU * @V305001 00558000
  562. DMSERR TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE',NUM=99,LET=E 00559000
  563. LA R15,RC40 RETURN CODE = 40 @V305066 00560000
  564. B EXIT GET OUT @V305001 00561000
  565. EJECT 00562000
  566. ERR105 LR R2,R15 WRBUF ERROR CODE @V305001 00563000
  567. DMSERR TEXT='ERROR ''..'' WRITING FILE ''....................'*00564000
  568. ' TO DISK',NUM=105,LET=S,SUB=(DEC,(R2),CHAR8A,FNAME), *00565000
  569. RENT=NO @V305001 00566000
  570. LA R15,RC100 RETURN CODE @V305001 00567000
  571. B EXIT GET OUT @V305001 00568000
  572. SPACE 1 00569000
  573. ERR097 EQU * @V305001 00570000
  574. DMSERR TEXT='NO ''SYSRES'' VOLUME ACTIVE',NUM=97,LET=E 00571000
  575. LA R15,RC36 RETURN CODE @V305001 00572000
  576. B EXIT GET OUT @V305001 00573000
  577. EJECT 00574000
  578. NUCON @V305001 00575000
  579. BGCOM @V305001 00576000
  580. MAPPUB @V305001 00577000
  581. REGEQU @V305001 00578000
  582. END 00579000
ibm/vm370-lib/cms/dmsprv.assemble_src.txt ยท Last modified: 2023/08/06 13:35 by Site Administrator