Table of Contents

DMKCFT Source

References

Source Listing

DMKCFT.ASSEMBLE.txt
  1. CFT TITLE 'DMKCFT (CP) VM/370 - RELEASE 6' 00001000
  2. ISEQ 73,80 VALIDATE INPUT SERIALIZATION 00002000
  3. *. 00003000
  4. * 00004000
  5. * MODULE NAME - 00005000
  6. * DMKCFT 00006000
  7. * 00007000
  8. * FUNCTION - 00008000
  9. * TO ALLOW THE USER TO SPECIFY OPTIONS FOR 00009000
  10. * HIS TERMINAL. 00010000
  11. * 00011000
  12. * ATTRIBUTES - 00012000
  13. * REENTRANT, PAGEABLE, CALLED VIA SVC 00013000
  14. * 00014000
  15. * ENTRY POINTS - 00015000
  16. * DMKCFTRM - THIS THE ONLY ENTRY POINT IN THIS MODULE 00016000
  17. * 00017000
  18. * ENTRY CONDITIONS - 00018000
  19. * GPR 9 - ADDRESS OF THE COMMAND LINE BUFFER 00019000
  20. * GPR 11- ADDRESS OF VMBLOK 00020000
  21. * GPR 13- ADDRESS OF SAVE AREA 00021000
  22. * 00022000
  23. * EXIT CONDITIONS - 00023000
  24. * NORMAL 00024000
  25. * GPR 2 = 0 00025000
  26. * 00026000
  27. * ERROR 00027000
  28. * GPR 2 = ERROR MESSAGE CODE 00028000
  29. * 00029000
  30. * CALLS TO OTHER ROUTINES - 00030000
  31. * DMKSCNFD - TO LOCATE THE NEXT ARGUMENT 00031000
  32. * DMKQCNWT - TO SEND RESPONSE MESSAGE TO TERMINAL 00032000
  33. * DMKERMSG - TO SEND ERROR MESSAGES TO TERMINAL 00033000
  34. * 00034000
  35. * TABLES/WORKAREAS - 00035000
  36. * VMBLOK, RDEVBLOK 00036000
  37. * 00037000
  38. * REGISTER USAGE - 00038000
  39. * GPR 0 - LENGTH OF ARGUMENT IN COMMAND LINE BUFFER 00039000
  40. * GPR 1 - ADDRESS OF ARGUMENT IN COMMAND LINE BUFFER 00040000
  41. * GPR 2 - PARAMETER REGISTER FOR CALLED ROUTINES 00041000
  42. * GPR 3 - ADDRESS OF THE FIRST ARGUMENT OF A PAIR 00042000
  43. * GPR 4 - LENGTH OF SECOND ARGUMENT OF A PAIR 00043000
  44. * GPR 5 - ADDRESS OF THE SECOND ARGUMENT OF A PAIR 00044000
  45. * GPR 6 - RETURN ADDRESS IF 'ON' SPECIFIED 00045000
  46. * GPR 7 - RETURN ADDRESS IF 'OFF' SPECIFIED 00046000
  47. * GPR 8 - ADDRESS OF TERMINAL RDEVBLOK 00047000
  48. * GPR 9 - ADDRESS OF THE COMMAND LINE BUFFER 00048000
  49. * GPR 10-ADDRESS OF SYSLOCS 00049000
  50. * GPR 11- ADDRESS OF VMBLOK 00050000
  51. * GPR 12- BASE REGISTER FOR THE MODULE 00051000
  52. * GPR 13- ADDRESS OF SAVEAREA 00052000
  53. * GPR 14- LINKAGE REGISTER 00053000
  54. * GPR 15- LINKAGE REGISTER 00054000
  55. * 00055000
  56. * NOTES - 00056000
  57. * NONE 00057000
  58. * 00058000
  59. * 00059000
  60. * COMMAND FORMAT - 00060000
  61. * 00061000
  62. * +------------+-------------------------------+ 00062000
  63. * | TERMINAL | CHARDEL ON | 00063000
  64. * | TERM | LINEDEL OFF | 00064000
  65. * | | LINEND (CHAR) | 00065000
  66. * | | ESCAPE | 00066000
  67. * | | TABCHAR | 00066500
  68. * | | | 00067000
  69. * | | APL | 00068000
  70. * | | ATTN | HRC101DK 00069090
  71. * | | AUTOCR | HRC101DK 00069180
  72. * | | HILIGHT ON | HRC101DK 00069270
  73. * | | HOLD OFF | HRC101DK 00069360
  74. * | | MASK | HRC101DK 00069450
  75. * | | TEXT | 00070100
  76. * | | | HRC101DK 00071190
  77. * | | TIMESTMP ON|OFF | HRC101DK 00071380
  78. * | | TIMESTAMP ON|OFF | HRC101DK 00071570
  79. * | | | 00072000
  80. * | | LINESIZE NNN | 00073000
  81. * | | | 00074000
  82. * | | MORE NNN NNN | HRC101DK 00074300
  83. * | | | HRC101DK 00074600
  84. * | | MODE CP | 00075000
  85. * | | VM | 00076000
  86. * +------------+-------------------------------+ 00077000
  87. * 00078000
  88. * 00079000
  89. * OPERATION - 00080000
  90. * 00081000
  91. * 1. CALL DMKSCNFD TO LOCATE THE NEXT ARGUMENT IN THE COMMAND 00082000
  92. * LINE. IF NONE FOUND AND NO PREVIOUS SET OF ARGUMENTS 00083000
  93. * HAVE BEEN PROCESSED, CALL DMKERMSG TO SEND DMKCFT026E 00084000
  94. * ERROR MESSAGE. IF NO ARGUMENT FOUND AND PREVIOUS PROCESS- 00085000
  95. * ING HAS BEEN DONE, CALL DMKQCNWT TO OUTPUT 'COMMAND 00086000
  96. * COMPLETE' MESSAGE AND EXIT. 00087000
  97. * 2. SAVE THE LENGTH AND ADDRESS OF THE FIRST ARGUMENT OF THE 00088000
  98. * SET, SET A FLAG TO INDICATE THIS, AND CALL DMKSCNFD TO 00089000
  99. * LOCATE THE SECOND ARGUMENT OF THE SET. IF NONE FOUND, CALL 00090000
  100. * DMKERMSG TO SEND DMKCFT026E ERROR MESSAGE. 00091000
  101. * 3. COMPARE THE FIRST ARGUMENT AGAINST A LIST OF VALID 00092000
  102. * ARGUMENTS. IF GET NO MATCHES, CALL DMKERMSG TO SEND 00093000
  103. * DMKCFT002E ERROR MESSAGE. 00094000
  104. * 4. IF MATCH IS FOUND, CHECK THE ARGUMENT FOR VALID ABREV- 00095000
  105. * IATION. IF NOT THE PROPER ABREVIATION, GO BACK TO STEP 3 00096000
  106. * TO CONTINUE SCAN OF THE LIST. IF GOOD ,GO TO THE PROPER 00097000
  107. * SUBROUTINE TO HANDLE THE REQUEST. 00098000
  108. * 5. APL - TEST IF THE TERMINAL IS A TTY. IF SO, CALL DMKERMSG 00099000
  109. * TO SEND ERROR MESSAGE DMKCFT006E. IF TERMINAL IS OTHER THAN 00100000
  110. * A TTY, GO TO STEP 12 TO INTERROGATE THE SECOND ARGUMENT. 00101000
  111. * IF ARGUMENT IS 'ON', RETURN TO STEP 5B. IF 'OFF' RETURN 00102000
  112. * TO STEP 5C. IF NEITHER, RETURN TO STEP 5A. 00103000
  113. * 5A. CALL DMKERMSG TO SEND DMKCFT002E ERROR MESSAGE. 00104000
  114. * 5B. CHECK IF 'APL' ALREADY ON. IF IT IS, GO TO STEP 1. IF 00105000
  115. * NOT, TURN THE 'APL' BIT IN THE RDEVTMCD FIELD OF 00106100
  116. * THE TERMINAL RDEVBLOK ON AND THE 'TEXT' BIT OFF. 00106200
  117. * GO TO STEP 1. 00106300
  118. * 5C. CHECK IF 'APL' ALREADY OFF. IF SO, GO TO STEP 1. IF NOT, 00108000
  119. * SUBTRACT '8' FROM THE RDEVTMCD FIELD AND GO TO STEP 1. 00109000
  120. * 5D. TEXT - TEST IF THE TERMINAL IS A 3277. IF NOT, 00109010
  121. * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFT006E. 00109020
  122. * IF TERMINAL IS A 3277, GO TO STEP 12 TO 00109030
  123. * THE SECOND ARGUMENT. IF ARGUMENT IS 'ON', RETURN 00109040
  124. * TO STEP 5E. IF 'OFF', RETURN TO STEP 5F. IF 00109050
  125. * NEITHER, GO TO STEP 5A. 00109060
  126. * 5E. CHECK IF 'TEXT' ALREADY ON. IF IT IS, GO TO 00109070
  127. * STEP 1. IF NOT, TURN TO 'TEXT' BIT IN THE 00109080
  128. * RDEVTMCD FIELD OF THE TERMINAL RDEVBLOK ON AND 00109090
  129. * THE 'APL' BIT OFF. GO TO STEP 1. 00109100
  130. * 5F. CHECK IF 'TEXT' ALREADY OFF. IF SO, GO TO STEP 1. 00109110
  131. * IF NOT, TURN OFF THE 'TEXT' BIT IN THE RDEVTMCD 00109120
  132. * FIELD AND GO TO STEP 1. 00109130
  133. * 6. CHARDEL - GO TO STEP 12 TO INTERROGATE SECOND ARGUMENT. 00110000
  134. * IF 'ON', RETURN TO STEP 6B. IF 'OFF', RETURN TO STEP 6C. 00111000
  135. * IF 'CHAR', RETURN TO STEP 6A. 00112000
  136. * 6A. MOVE THE SPECIFIED CHARACTER INTO THE RDEVCDEL FIELD OF 00113000
  137. * THE TERMINAL RDEVBLOK AND GO TO STEP 1. 00114000
  138. * 6B. MOVE THE SYSTEM DEFAULT CHARDEL CHARACTER FROM 00115000
  139. * DMKSYSCD IN SYSLOCS TO THE RDEVCDEL FIELD AND GO TO 00116000
  140. * STEP 1. 00117000
  141. * 6C. ZERO OUT THE RDEVCDEL FIELD AND GO TO STEP 1. 00118000
  142. * 7. LINEDEL - GO TO STEP 12 TO INTERROGATE THE SECOND 00119000
  143. * ARGUMENT.IF 'ON' RETURN TO STEP 7B--IF 'OFF' RETURN TO 00120000
  144. * STEP 7C--IF A CHARACTER ,RETURN TO STEP 7A. 00121000
  145. * 7A. MOVE THE ENTERED CHARACTER INTO THE RDEVLDEL FIELD OF 00122000
  146. * THE RDEVBLOK AND GO TO STEP 1. 00123000
  147. * 7B. MOVE THE SYSTEM DEFAULT LINE DELETE CHARACTER FROM THE 00124000
  148. * DMKSYSLD FIELD IN SYSLOCS TO RDEVLDEL AND GO TO STEP 1. 00125000
  149. * 7C. ZERO OUT THE RDEVLDEL FIELD AND GO TO STEP 1. 00126000
  150. * 8. LINEND - GO TO STEP 12 TO INTERROGATE THE SECOND ARGUMENT. 00127000
  151. * IF 'ON' RETURN TO STEP 8B -- IF 'OFF', RETURN TO STEP 8C 00128000
  152. * AND IF CHARACTER, RETURN TO STEP 8A. 00129000
  153. * 8A. MOVE THE SPECIFIED CHARACTER INTO THE RDEVLEND FIELD OF 00130000
  154. * THE TERMINAL RDEVBLOK AND GO TO STEP 1. 00131000
  155. * 8B. MOVE THE SYSTEM DEFAULT LINE END CHARACTER FROM THE 00132000
  156. * DMKSYSLE FIELD OF SYSLOCS AND GO TO STEP 1. 00133000
  157. * 8C. ZERO OUT THE RDEVLEND FIELD AND GO TO STEP 1. 00134000
  158. * 9. ESCAPE - GO TO STEP 12 TO INTERROGATE THE SECOND ARGUMENT. 00135000
  159. * IF 'ON', RETURN TO STEP 9B-- IF 'OFF' RETURN TO STEP 9C 00136000
  160. * AND IF A CHARACTER, RETURN TO STEP 9A. 00137000
  161. * 9A. MOVE THE SPECIFIED CHARACTER INTO THE RDEVESCP FIELD OF 00138000
  162. * RDEVBLOK FOR THE TERMINAL AND GO TO STEP 1. 00139000
  163. * 9B. MOVE THE SYSTEM DEFAULT ESCAPE CHARACTER FROM THE 00140000
  164. * DMKSYSES FIELD OF SYSLOCS TO THE RDEVESCP FIELD OF THE 00141000
  165. * TERMINAL RDEVBLOK AND GO TO STEP 1. 00142000
  166. * 9C. ZERO OUT THE RDEVESCP FIELD IN THE RDEVBLOK AND GO TO 00143000
  167. * STEP 1. 00144000
  168. * 9.1. TABCHAR - INVOKE STEP 12 TO DETERMINE WHETHER 'ON', 'OFF', 00144070
  169. * OR 'CHAR' WAS SPECIFIED AS THE ARGUMENT FOR THE TABCHAR. 00144140
  170. * IF 'ON' RETURN TO STEP 9.1B, IF 'OFF' RETURN TO STEP 9.1C, 00144210
  171. * OR IF A CHARACTER RETURN TO STEP 9.1A. 00144280
  172. * 9.1A. CHECK THAT THE SPECIFIED CHARACTER IS NOT ALPHABETIC, 00144350
  173. * NUMERIC, OR A 3270 CONTROL CHARACTER; IF SO, MOVE IT INTO 00144420
  174. * THE VMGRFTAB FIELD OF THE USER'S VMBLOK, OTHERWISE, DON'T 00144490
  175. * CHANGE VMGRFTAB AND SEND AN INVALID OPERAND MESSAGE. 00144560
  176. * 9.1B. MOVE THE SYSTEM DEFAULT TAB CHAR (X'6A') INTO THE USER'S 00144630
  177. * VMGRFTAB AND GO TO STEP 1. 00144700
  178. * 9.1C. ZERO OUT THE USER'S VMGRFTAB FIELD OF THE VMBLOK AND THEN 00144770
  179. * GO TO STEP 1. 00144840
  180. * 10. LINESIZE - CALL DMKCVTDB TO CONVERT THE SECOND ARGUMENT 00145000
  181. * TO BINARY. IF THE CONVERT FAILS, CALL DMKERMSG TO SEND 00146000
  182. * DMKCFT002E ERROR MESSAGE.THEN CHECK IF A LINESIZE OF ZERO 00147000
  183. * WAS SPECIFIED. IF SO , CALL DMKERMSG TO SEND DMKCFT002E 00148000
  184. * ERROR MESSAGE. IF NUMBER IS OK, STORE THE NEW 00149000
  185. * LINESIZE INTO THE RDEVLLEN FIELD OF THE TERMINAL 00150000
  186. * RDEVBLOK AND GO TO STEP 1. 00151000
  187. * 11. MASK - GO TO STEP 12 TO INTERROGATE THE SECOND ARGUMENT. 00152000
  188. * IF 'ON' RETURN TO STEP 11B -- IF 'OFF' , RETURN TO 00153000
  189. * STEP 11C -- AND IF NEITHER, RETURN TO STEP 11A. 00154000
  190. * 11A. CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFT002E. 00155000
  191. * 11B. TURN OFF THE RDEVPSUP FLAG IN THE RDEVFLAG FIELD 00156000
  192. * OF THE TERMINAL RDEVBLOK AND GO TO STEP 1. 00157000
  193. * 11C. TURN ON THE RDEVPSUP FLAG IN THE RDEVFLAG FIELD 00158000
  194. * OF THE TERMINAL RDEVBLOK AND GO TO STEP 1. 00159000
  195. * 12. THIS IS A SUBROUTINE TO CHECK SECOND ARGUMENT OF A SET. 00160000
  196. * CHECK IF 'OFF'. IF IT IS RETURN ON REGISTER 7. IF NOT 00161000
  197. * CHECK FOR 'ON'. IF IT IS, RETURN ON REGISTER 6. IF 00162000
  198. * NEITHER OF THESE, RETURN ON REGISTER 14. 00163000
  199. * 13. MODE OPTION, CHECK FOR VALID ARG, CP OR VM. 00164000
  200. * SET THE APPROPRIATE VMBLOK STATUS OR ISSUE ERROR MSG 00165000
  201. * 00166000
  202. * 00167000
  203. * RESPONSES - 00168000
  204. * NONE 00169000
  205. * 00170000
  206. * ERROR MESAGES - 00171000
  207. * DMKCFT002E INVALID OPERAND - (OPERAND) 00172000
  208. * DMKCFT006E INVALID DEVICE TYPE - (ADDR) 00173000
  209. * DMKCFT026E OPERAND MISSING OR INVALID 00174000
  210. * 00175000
  211. *. 00176000
  212. COPY OPTIONS @V407510 00176100
  213. EJECT 00176200
  214. SPACE 3 00177000
  215. DMKCFT CSECT 00178000
  216. SPACE 2 00179000
  217. MODID DC CL8'DMKCFT' 00180000
  218. SPACE 2 00181000
  219. EXTRN DMKSCNFD 00182000
  220. EXTRN DMKCVTDB 00183000
  221. EXTRN DMKCVTBH 00184000
  222. EXTRN DMKSCNVD @V200820 00185000
  223. EXTRN DMKERMSG 00186000
  224. EXTRN DMKTBLGR @V60A6B6 00186500
  225. SPACE 2 00187000
  226. USING PSA,R0 00188000
  227. USING VMBLOK,R11 00189000
  228. USING SAVEAREA,R13 00190000
  229. SPACE 2 00191000
  230. FIRSTARG EQU X'80' INDICATE THAT A FIRST ARGUMENT WAS SPEC. 00192000
  231. SECNDARG EQU X'40' INDICATE THAT A SECOND ARG. WAS SPEC. 00193000
  232. TERMDONE EQU X'20' AT LEAST ONE TERM. COMM. PROCESSED 00194000
  233. ZIP EQU X'00' USED TO ZERO FIELDS 00195000
  234. EJECT 00196000
  235. DMKCFTRM RELOC 00197000
  236. MVC SAVEWRK1(4),ZEROES ZERO FLAG AREA 00198000
  237. CFTARG1 CALL DMKSCNFD LOCATE FIRST ARGUMENT 00199000
  238. BZ CFTSAV1 HAVE ARGUMENT - GO PROCESS 00200000
  239. TM SAVEWRK1,TERMDONE ANY PROCESSING DONE ? 00201000
  240. BO TERMEXIT YES - TAKE BRANCH 00202000
  241. B CFT026 NO ARGUMENTS FOUND 00203000
  242. CFTSAV1 LR R2,R0 SAVE LENGTH OF FIRST ARG. 00204000
  243. LR R3,R1 SAVE ADDRESS OF FIRST ARG. 00205000
  244. OI SAVEWRK1,FIRSTARG INDICATE FIRST ARG RECIEVED 00206000
  245. CALL DMKSCNFD LOCATE SECOND ARGUMENT 00207000
  246. BNZ CFT026 NOT A PAIR OF ARGUMENTS 00208000
  247. LR R4,R2 LENGTH OF FIRST ARGUMENT TO R4 00209000
  248. BCTR R4,0 MINUS ONE FOR 'EX' 00210000
  249. LA R5,TERMBGN INITIALIZE BXLE REGS FOR SCAN 00211000
  250. LA R6,TERMLEN LENGTH OF ONE ENTRY @V200820 00212000
  251. LA R7,TERMEND . . . 00213000
  252. SPACE 00214000
  253. SCANLOOP EX R4,TERMCLC COMPARE ARGUMENT TO LIST 00215000
  254. BE TERMABRV IF GET A HIT, GO CHECK ABREVIATION 00216000
  255. SPACE 00217000
  256. TERMBXLE BXLE R5,R6,SCANLOOP GO BACK IF HAVE MORE IN LIST 00218000
  257. B CFT002 SEND ERROR MESSAGE IF CAN'T FIND 00219000
  258. SPACE 00220000
  259. TERMABRV EQU * HRC101DK 00221190
  260. SR R8,R8 HRC101DK 00221380
  261. IC R8,9(,R5) GET MINIMUM LENGTH HRC101DK 00221570
  262. BCTR R8,0 SET UP FOR 'EX' 00222000
  263. EX R8,TERMCLC MAKE SURE HAVE ENOUGH CHARACTERS 00223000
  264. BNE TERMBXLE GO SCAN SOME MORE IF NOT CORRECT 00224000
  265. LR R6,R5 ADDRESS OF LIST ENTRY TO R6 00225000
  266. LR R5,R1 ADDRESS OF SECOND ARGUMENT TO R5 00226000
  267. LR R4,R0 LENGTH OF SECOND ARGUMENT 00227000
  268. L R8,VMTERM LOAD TERMINAL RDEVBLOK ADDRESS 00228000
  269. USING RDEVBLOK,R8 00229000
  270. L R10,ASYSLC ADDRESS OF SYSLOCS 00230000
  271. USING SYSLOCS,R10 00231000
  272. LH R15,10(0,R6) PICK UP DISPLACEMENT TO SUBROUTIN@V200820 00232000
  273. B DMKCFT(R15) GO TO IT @V200820 00233000
  274. EJECT 00234000
  275. TERMBGN DS 0F START OF DECODING TABLE @V200820 00235000
  276. DC C'AUTOCR ',H'2',AL2(AUTOCR-DMKCFT) HRC101DK 00236090
  277. DC C'HOLD ',H'2',AL2(HOLD-DMKCFT) HRC101DK 00236180
  278. DC C'MORE ',H'4',AL2(MORE-DMKCFT) HRC101DK 00236270
  279. DC C'TIMESTAMP',AL1(4),AL2(STAMP-DMKCFT) HRC101DK 00236360
  280. DC C'HILIGHT ',H'4',AL2(HIGHLITE-DMKCFT) HRC101DK 00236450
  281. DC C'CHARDEL ',H'2',AL2(CHARDEL-DMKCFT) HRC101DK 00236540
  282. DC C'LINEDEL ',H'5',AL2(LINEDEL-DMKCFT) @V200820 00237000
  283. DC C'LINEND ',H'5',AL2(LINEND-DMKCFT) @V200820 00238000
  284. DC C'ESCAPE ',H'2',AL2(ESCAPE-DMKCFT) @V200820 00239000
  285. DC C'TABCHAR ',H'3',AL2(TABCHAR-DMKCFT) @V60A6B6 00239500
  286. DC C'MASK ',H'1',AL2(MASK-DMKCFT) @VM08722 00240000
  287. DC C'ATTN ',H'2',AL2(TERMATTN-DMKCFT) @V200820 00241000
  288. DC C'APL ',H'3',AL2(APL-DMKCFT) @V200820 00242000
  289. DC C'TEXT ',H'4',AL2(TEXT-DMKCFT) @V387398 00242100
  290. DC C'LINESIZE',H'5',AL2(LINESIZE-DMKCFT) @V200820 00243000
  291. DC C'MODE ',H'3',AL2(MODE-DMKCFT) HRC101DK 00244590
  292. TERMEND DC C'TIMESTMP',H'6',AL2(STAMP-DMKCFT) HRC101DK 00245180
  293. TERMLEN EQU *-TERMEND LENGTH OF ONE ENTRY @V200820 00246000
  294. TERMCLC CLC 0(0,R3),0(R5) EXECUTED COMPARE 00247000
  295. EJECT 00248000
  296. APL EQU * 00249000
  297. LTR R8,R8 IS THERE A REAL DEVICE BLOCK ? @V200820 00250000
  298. BNP TONDONE NO -- DON'T DO ANYTHING @V200820 00251000
  299. CLI RDEVTYPC,CLASTERM IS THIS A LOCAL TERMINAL ? @V200820 00252000
  300. BNE TSTGRAF NO,TEST FOR GRAF DEVICE @V305798 00253000
  301. CLI RDEVTYPE,TYPBSC IS IT A REMOTE 3270 ? @V305798 00254000
  302. BNE BSCEND NO,ERROR @V305798 00255000
  303. BAL R3,GETNICB FIND NICBLOK @V305798 00256000
  304. USING NICBLOK,R2 @V305798 00257000
  305. LA R6,APLRON LOAD TURN ON @V305798 00258000
  306. LA R7,APLROFF LOAD TURN OFF @V305798 00259000
  307. B APLRCHK @V305798 00260000
  308. BSCEND EQU * @V305798 00261000
  309. CLI RDEVTYPE,TYPTTY TELEGRAPH TERMINAL ? @V200820 00262000
  310. BNL CFT006 YES - APL NOT VALID HERE @V200820 00263000
  311. B SETAPL SET ON RETURN @V305798 00264000
  312. TSTGRAF CLI RDEVTYPC,CLASGRAF IS IT A GRAF TYPE ? @V305798 00265000
  313. BNE CFT006 NO, ERROR @V305798 00266000
  314. TM RDEVTYPE,TYP3277+TYP3278 IS IT A 3270 TYPE? @V60A6B6 00267000
  315. BZ CFT006 NO, ERROR @V60A6B6 00268000
  316. SETAPL LA R6,APLON SET RETURN FOR ON @V305798 00269000
  317. LA R7,APLOFF RETURN FOR 'OFF' 00270000
  318. APLRCHK EQU * @V305798 00271000
  319. BAL R14,TSTONOFF GO DO TEST FOR ON/OFF 00272000
  320. B LOADARG2 IF RETURN HERE = BAD ARGUMENT 00273000
  321. SPACE 00274000
  322. APLON OI RDEVTMCD,RDEVAPLP SET THE APL BIT - X'08' @V200820 00275000
  323. NI RDEVTMCD,255-RDEVTEXT TURN OFF TEXT BIT @V387398 00275100
  324. B TONDONE . . . 00276000
  325. SPACE 00277000
  326. APLOFF NI RDEVTMCD,255-RDEVAPLP TURN OFF APL BIT @V200820 00278000
  327. B TONDONE . . . 00279000
  328. APLRON OI NICTMCD,NICAPL @V305798 00280000
  329. NI NICTMCD,255-NICTEXT TURN OFF TEXT BIT @V387398 00280100
  330. B TONDONE TURN APL ON @V305798 00281000
  331. APLROFF NI NICTMCD,255-NICAPL TURN APL OFF @V305798 00282000
  332. B TONDONE @V305798 00283000
  333. EJECT 00284000
  334. TEXT EQU * @V387398 00284010
  335. LTR R8,R8 IS THERE A REAL DEVICE BLOCK ? @V387398 00284020
  336. BNP TONDONE NO -- DON'T DO ANYTHING @V387398 00284030
  337. CLI RDEVTYPC,CLASTERM IS THIS A LOCAL TERMINAL ? @V387398 00284040
  338. BNE TTSTGRAF NO,TEST FOR GRAF DEVICE @V387398 00284050
  339. CLI RDEVTYPE,TYPBSC IS IT A REMOTE 3270 ? @V387398 00284060
  340. BNE CFT006 NO,ERROR @V387398 00284070
  341. BAL R3,GETNICB FIND NICBLOK @V387398 00284080
  342. USING NICBLOK,R2 @V387398 00284090
  343. LA R6,TEXTRON LOAD TURN ON @V387398 00284100
  344. LA R7,TEXTROFF LOAD TURN OFF @V387398 00284110
  345. B TEXTRCHK @V387398 00284120
  346. TTSTGRAF CLI RDEVTYPC,CLASGRAF IS IT A GRAF TYPE ? @V387398 00284130
  347. BNE CFT006 NO, ERROR @V387398 00284140
  348. TM RDEVTYPE,TYP3277+TYP3278 IS IT A 3270 TYPE ? @V60A6B6 00284150
  349. BZ CFT006 NO, ERROR @V60A6B6 00284160
  350. LA R6,TEXTON SET RETURN FOR ON @V387398 00284170
  351. LA R7,TEXTOFF RETURN FOR 'OFF' @V387398 00284180
  352. TEXTRCHK EQU * @V387398 00284190
  353. BAL R14,TSTONOFF GO DO TEST FOR ON/OFF @V387398 00284200
  354. B LOADARG2 IF RETURN HERE = BAD ARGUMENT @V387398 00284210
  355. SPACE 00284220
  356. TEXTON OI RDEVTMCD,RDEVTEXT SET THE TEXT BIT - X'20' @V387398 00284230
  357. NI RDEVTMCD,255-RDEVAPLP TURN OFF APL BIT @V387398 00284240
  358. B TONDONE . . . @V387398 00284250
  359. SPACE 00284260
  360. TEXTOFF NI RDEVTMCD,255-RDEVTEXT TURN OFF TEXT BIT @V387398 00284270
  361. B TONDONE . . . @V387398 00284280
  362. TEXTRON OI NICTMCD,NICTEXT TURN TEXT ON @V387398 00284290
  363. NI NICTMCD,255-NICAPL TURN APL OFF @V387398 00284300
  364. B TONDONE @V387398 00284310
  365. TEXTROFF NI NICTMCD,255-NICTEXT TURN TEXT OFF @V387398 00284320
  366. B TONDONE @V387398 00284330
  367. EJECT 00284340
  368. CHARDEL LA R6,CHARON RETURN FOR ON 00285000
  369. LA R7,CHAROFF RETURN FOR OFF 00286000
  370. BAL R14,TSTCHAR GO TEST FOR ON/OFF/CHAR @VA04451 00287500
  371. * 00288000
  372. * RETURN HERE IF CHAR WAS SPECIFIED 00289000
  373. * 00290000
  374. MVC VMTCDEL(1),0(R5) MOVE IN SPECIFIED CHARACTER @V200820 00291000
  375. B TONDONE . . 00292000
  376. SPACE 00293000
  377. CHARON MVC VMTCDEL(1),DMKSYSCD MOVE IN SYSTEM DEFAULT CHAR @V200820 00294000
  378. B TONDONE 00295000
  379. SPACE 00296000
  380. CHAROFF MVI VMTCDEL,X'00' DO NOT USE CHARACTER DELETE @V200820 00297000
  381. B TONDONE 00298000
  382. EJECT 00299000
  383. LINEDEL LA R6,LINDON RETURN FOR ON 00300000
  384. LA R7,LINDOFF RETURN FOR OFF 00301000
  385. BAL R14,TSTCHAR GO TEST FOR ON/OFF/CHAR @VA04451 00302500
  386. * 00303000
  387. * RETURN HERE IF CHAR SPECIFIED 00304000
  388. * 00305000
  389. MVC VMTLDEL(1),0(R5) MOVE IN SPECIFIED CHARACTER @V200820 00306000
  390. B TONDONE . . 00307000
  391. LINDON DS 0H @VA09934 00307100
  392. TM RDEVTMCD,RDEVUSC8 IS IT ASCII TYPE ??? @VA09934 00307200
  393. BZ NOTASC NO...BRANCH @VA09934 00307300
  394. MVI VMTLDEL,BRACKET SET LINE DEL TO LEFT BRACKET @VA09934 00307400
  395. B TONDONE @VA09934 00307500
  396. SPACE 00308000
  397. NOTASC DS 0H @VA09934 00309100
  398. MVC VMTLDEL(1),DMKSYSLD MOVE IN SYSTEM DEFAULT CHAR @VA09934 00309200
  399. B TONDONE . . 00310000
  400. SPACE 00311000
  401. LINDOFF MVI VMTLDEL,X'00' DO NOT USE LINE DELETE @V200820 00312000
  402. B TONDONE 00313000
  403. EJECT 00314000
  404. LINEND LA R6,LINENDON RETURN FOR ON 00315000
  405. LA R7,LINENOFF RETURN FOR OFF 00316000
  406. BAL R14,TSTCHAR GO TEST FOR ON/OFF/CHAR @VA04451 00317500
  407. * 00318000
  408. * RETURN HERE FOR CHAR 00319000
  409. * 00320000
  410. MVC VMTLEND(1),0(R5) MOVE IN SPECIFIED CHARACTER @V200820 00321000
  411. B TONDONE . . 00322000
  412. SPACE 00323000
  413. LINENDON MVC VMTLEND(1),DMKSYSLE MOVE IN SYSTEM DEFAULT CHAR @V200820 00324000
  414. B TONDONE . . 00325000
  415. SPACE 00326000
  416. LINENOFF MVI VMTLEND,X'00' DO NOT USE LOGICAL LINE END @V200820 00327000
  417. B TONDONE 00328000
  418. EJECT 00329000
  419. ESCAPE LA R6,ESCPON RETURN IF 'ON' 00330000
  420. LA R7,ESCPOFF RETURN IF 'OFF' 00331000
  421. BAL R14,TSTCHAR GO TEST FOR ON/OFF/CHAR @VA04451 00332500
  422. MVC VMTESCP(1),0(R5) MOVE IN SPECIFIED CHARACTER @V200820 00333000
  423. B TONDONE 00334000
  424. SPACE 00335000
  425. ESCPON MVC VMTESCP(1),DMKSYSES MOVE IN SYSTEM DEFAULT CHAR @V200820 00336000
  426. B TONDONE 00337000
  427. SPACE 00338000
  428. ESCPOFF MVI VMTESCP,X'00' DO NOT USE ESCAPE CHARACTER @V200820 00339000
  429. B TONDONE 00340000
  430. EJECT 00341000
  431. TABCHAR LA R6,TABCHON RETURN IF 'ON' @V60A6B6 00341040
  432. LA R7,TABCHOFF RETURN IF 'OFF' @V60A6B6 00341080
  433. BAL R14,TSTCHAR GO TEST FOR ON/OFF/CHAR @V60A6B6 00341120
  434. L R7,=A(DMKTBLGR) MUST TRANSLATE 3270 @V60A6B6 00341160
  435. TR 0(1,R5),0(R7) ORDERS TO BLANKS @V60A6B6 00341200
  436. CLI 0(R5),X40 IS CHARACTER A BLANK ? @V60A6B6 00341240
  437. BE LOADARG2 IF YES, THEN THIS IS AN ERROR @V60A6B6 00341280
  438. MVC VMGRFTAB(1),0(5) MOVE IN SPECIFIED CHARACTER @V60A6B6 00341320
  439. B TONDONE @V60A6B6 00341360
  440. SPACE 00341400
  441. TABCHON MVI VMGRFTAB,X6A MOVE IN SYSTEM DEFAULT CHAR @V60A6B6 00341440
  442. B TONDONE @V60A6B6 00341480
  443. SPACE 00341520
  444. TABCHOFF MVI VMGRFTAB,X00 ZERO THE LOGICAL TAB CHARACTER @V60A6B6 00341560
  445. B TONDONE @V60A6B6 00341600
  446. SPACE 00341640
  447. X00 EQU X'00' @V60A6B6 00341680
  448. X40 EQU X'40' @V60A6B6 00341720
  449. X6A EQU X'6A' @V60A6B6 00341760
  450. EJECT HRC101DK 00341762
  451. HIGHLITE EQU * HRC101DK 00341764
  452. LA R6,HILION RETURN FOR ON HRC101DK 00341766
  453. LA R7,HILIOFF SET UP FOR 'OFF' HRC101DK 00341768
  454. BAL R14,TSTONOFF GO CHECK ARGUMENT HRC101DK 00341770
  455. * HRC101DK 00341772
  456. * IF RETURN HERE - HAVE BAD ARGUMENT HRC101DK 00341774
  457. * HRC101DK 00341776
  458. B LOADARG2 G0 SEND ERROR MESSAGE HRC101DK 00341778
  459. SPACE , HRC101DK 00341780
  460. HILIOFF NI VMMLVL2,X'FF'-VMMHLITE SET FLAG OFF HRC101DK 00341782
  461. B TONDONE CONTINUE HRC101DK 00341784
  462. SPACE , HRC101DK 00341786
  463. HILION OI VMMLVL2,VMMHLITE FLAG FOR HILIGHT ON HRC101DK 00341788
  464. B TONDONE CONTINUE HRC101DK 00341790
  465. EJECT 00341800
  466. LINESIZE LR R0,R4 LENGTH TO REG 0 00342000
  467. LR R1,R5 ADDRESS TO REG 1 00343000
  468. CALL DMKCVTDB GO CONVERT TO BINARY 00344000
  469. BNZ LOADARG2 BAD CONVERT 00345000
  470. CL R1,F255 ANYTHING OVER 255 IS ERROR 00346000
  471. BH LOADARG2 .......... 00347000
  472. N R1,F255 SAVE ONLY LOW ORDER BYTE 00348000
  473. LTR R1,R1 IS LINESIZE ZERO ? 00349000
  474. BZ LOADARG2 YES - NO CAN DO 00350000
  475. LTR R8,R8 IS THERE A TERMINAL RDEVBLOK ? @V200820 00351000
  476. BNP TONDONE NO -- DON'T DO ANYTHING @V200820 00352000
  477. CLI RDEVTYPC,CLASTERM IS THIS A LOCAL TERMINAL @V2D3931 00353000
  478. BNE *+12 NO, BYPASS TEST FOR 3270 REMOTE @V2D3931 00354000
  479. CLI RDEVTYPE,TYPBSC IS THIS A 3270 BISYNC LINE @V2D3931 00355000
  480. BE *+12 YES, GET POINTER TO NICBLOK @V2D3931 00356000
  481. CLI RDEVTYPC,CLASSPEC IS THIS A LOCAL TERMINAL ? @V200820 00357000
  482. BNE SETRLEN YES -- SET LINE LENGTH @V200820 00358000
  483. BAL R3,GETNICB GET THE NICBLOK ADDRESS @V200820 00359000
  484. USING NICBLOK,R2 @V200820 00360000
  485. STC R1,NICLLEN SET THE TERMINAL LINE LENGTH @V200820 00361000
  486. B TONDONE ALL DONE HERE @V200820 00362000
  487. SETRLEN EQU * SET LINE LENGTH FOR LOCAL TERM @V200820 00363000
  488. STC R1,RDEVLLEN STORE NEW LINE LENGTH 00364000
  489. B TONDONE . . 00365000
  490. EJECT , HRC101DK 00366020
  491. MORE DS 0H HRC101DK 00366040
  492. ICM R2,B'0011',VMMORETM GET CURRENT VALUES HRC101DK 00366060
  493. CLI RDEVTYPC,CLASTERM ? HRC101DK 00366080
  494. BE CFT006 YES, ERROR HRC101DK 00366100
  495. LR R0,R4 HRC101DK 00366120
  496. LR R1,R5 HRC101DK 00366140
  497. CALL DMKCVTDB CONVERT TO BINARY HRC101DK 00366160
  498. BNZ LOADARG2 ....... HRC101DK 00366180
  499. CL R1,F255 <= 255 HRC101DK 00366200
  500. BH LOADARG2 ....... HRC101DK 00366220
  501. N R2,=X'000000FF' ZERO OUT OLD HRC101DK 00366240
  502. SLL R1,8 SHIFT INTO CORRECT POSITION HRC101DK 00366260
  503. OR R2,R1 INSERT IT HRC101DK 00366280
  504. CALL DMKSCNFD GET SECOND TIME VALUE HRC101DK 00366300
  505. LR R4,R0 HRC101DK 00366320
  506. LR R5,R1 HRC101DK 00366340
  507. CALL DMKCVTDB CONVERT TO BINARY HRC101DK 00366360
  508. BNZ LOADARG2 ....... HRC101DK 00366380
  509. CL R1,F255 <= 255 HRC101DK 00366400
  510. BH LOADARG2 ....... HRC101DK 00366420
  511. N R2,=X'0000FF00' ZERO OUT OLD HRC101DK 00366440
  512. OR R2,R1 INSERT IT HRC101DK 00366460
  513. STCM R2,B'0011',VMMORETM SAVE CURRENT VALUES HRC101DK 00366480
  514. B TONDONE HRC101DK 00366500
  515. EJECT , HRC101DK 00366520
  516. MASK EQU * TERMINAL MASK ON / OFF @V200820 00367000
  517. LTR R8,R8 IS THERE A TERMINAL RDEVBLOK ? @V200820 00368000
  518. BNP TONDONE NO -- DO NOTHING @V200820 00369000
  519. CLI RDEVTYPC,CLASGRAF GRAPHICS TERMINAL ? @V200820 00370000
  520. BE CFT006 YES - INVALID DEVICE TYPE @V200820 00371000
  521. CLI RDEVTYPC,CLASTERM IS THIS A LOCAL TERMINAL @V2D3931 00372000
  522. BNE *+12 NO, BYPASS TEST FOR 3270 REMOTE @V2D3931 00373000
  523. CLI RDEVTYPE,TYPBSC IS THIS A 3270 REMOTE LINE @V2D3931 00374000
  524. BE CFT006 YES, INVALID DEVICE TYPE @V2D3931 00375000
  525. CLI RDEVTYPC,CLASSPEC 3705-BASED TERMINAL ? @V200820 00376000
  526. BNE MASKTRM NO -- PROCESS NORMALLY @V200820 00377000
  527. BAL R3,GETNICB GET THE NICBLOK ADDRESS @V200820 00378000
  528. LA R6,MASKSON RETURN FOR 'ON' @V200820 00379000
  529. LA R7,MASKSOFF RETURN FOR 'OFF' @V200820 00380000
  530. B MASKS GO CHECK FOR ON OR OFF @V200820 00381000
  531. MASKTRM EQU * @V200820 00382000
  532. SWITCH SWITCH TO MAIN PROCESSOR @V407510 00382100
  533. LA R6,MASKON RETURN FOR ON @V200820 00383000
  534. LA R7,MASKOFF RETURN FOR OFF 00384000
  535. MASKS EQU * @V200820 00385000
  536. BAL R14,TSTONOFF GO - TEST FOR ON/OFF 00386000
  537. * 00387000
  538. * IF RETURN HERE - MEANS BAD ARGUMENT 00388000
  539. * 00389000
  540. B LOADARG2 GO -SEND ERROR MESSAGE 00390000
  541. SPACE 00391000
  542. MASKON NI RDEVFLAG,255-RDEVPSUP TURN OFF PRINT SUPPRESS FEATURE 00392000
  543. B TONDONE . . 00393000
  544. SPACE 00394000
  545. MASKOFF OI RDEVFLAG,RDEVPSUP INDICAT THAT PRINT SUPP. AVAILABLE 00395000
  546. B TONDONE ... 00396000
  547. SPACE 00397000
  548. MASKSON NI NICFLAG,255-NICPSUP TURN ON MASK @V200820 00398000
  549. B TONDONE @V200820 00399000
  550. SPACE 00400000
  551. MASKSOFF OI NICFLAG,NICPSUP TURN OFF MASK @V200820 00401000
  552. B TONDONE @V200820 00402000
  553. EJECT 00403000
  554. TERMATTN LTR R8,R8 IS THERE A TERMINAL RDEVBLOK ? @V200820 00404000
  555. BNP TONDONE NO -- DO NOTHING @V200820 00405000
  556. CLI RDEVTYPC,CLASGRAF GRAPHICS TERMINAL ? @V200820 00406000
  557. BE CFT006 YES - INVALID DEVICE TYPE @V200820 00407000
  558. CLI RDEVTYPC,CLASTERM IS THIS A LOCAL TERMINAL @V2D3931 00408000
  559. BNE *+12 NO, BYPASS TEST FOR 3270 REMOTE @V2D3931 00409000
  560. CLI RDEVTYPE,TYPBSC IS THIS A 3270 REMOTE LINE @V2D3931 00410000
  561. BE CFT006 YES, INVALID DEVICE TYPE @V2D3931 00411000
  562. CLI RDEVTYPC,CLASSPEC 3705-BASED TERMINAL ? @V200820 00412000
  563. BNE TERMATT NO -- PROCESS NORMALLY @V200820 00413000
  564. BAL R3,GETNICB GET THE NICBLOK ADDRESS @V200820 00414000
  565. LA R6,ATTNSON RETURN FOR 'ON' @V200820 00415000
  566. LA R7,ATTNSOFF RETURN FOR 'OFF' @V200820 00416000
  567. B TERMATS GO FIND OUT WHICH IT IS @V200820 00417000
  568. TERMATT LA R6,ATTNON RETURN FOR ON @V200820 00418000
  569. LA R7,ATTNOFF SET UP FOR 'OFF' 00419000
  570. TERMATS EQU * @V200820 00420000
  571. BAL R14,TSTONOFF GO CHECK ARGUMENT 00421000
  572. * 00422000
  573. * IF RETURN HERE - HAVE BAD ARGUMENT 00423000
  574. * 00424000
  575. B LOADARG2 G0 SEND ERROR MESSAGE 00425000
  576. SPACE 00426000
  577. ATTNON NI RDEVTFLG,X'FF'-RDEVATOF RESET OFF FLAG FOR TERMINAL 00427000
  578. B TONDONE CONTINUE 00428000
  579. SPACE 00429000
  580. ATTNOFF OI RDEVTFLG,RDEVATOF SET FLAG FOR ATTN OFF 00430000
  581. B TONDONE CONTINUE 00431000
  582. SPACE 00432000
  583. ATTNSON NI NICFLAG,255-NICATOF TURN ATTN CHAR ON @V200820 00433000
  584. B TONDONE @V200820 00434000
  585. SPACE 00435000
  586. ATTNSOFF OI NICFLAG,NICATOF TURN ATTN CHAR OFF @V200820 00436000
  587. B TONDONE @V200820 00437000
  588. EJECT HRC101DK 00438040
  589. AUTOCR EQU * HRC101DK 00438080
  590. LA R6,AUTOON RETURN FOR ON HRC101DK 00438120
  591. LA R7,AUTOOFF SET UP FOR 'OFF' HRC101DK 00438160
  592. BAL R14,TSTONOFF GO CHECK ARGUMENT HRC101DK 00438200
  593. * HRC101DK 00438240
  594. * IF RETURN HERE - HAVE BAD ARGUMENT HRC101DK 00438280
  595. * HRC101DK 00438320
  596. B LOADARG2 G0 SEND ERROR MESSAGE HRC101DK 00438360
  597. SPACE , HRC101DK 00438400
  598. AUTOOFF NI VMMLVL2,X'FF'-VMMAUTCR SET FLAG OFF HRC101DK 00438440
  599. B TONDONE CONTINUE HRC101DK 00438480
  600. SPACE , HRC101DK 00438520
  601. AUTOON OI VMMLVL2,VMMAUTCR FLAG FOR AUTOCR ON HRC101DK 00438560
  602. B TONDONE CONTINUE HRC101DK 00438600
  603. EJECT HRC101DK 00438640
  604. HOLD EQU * HRC101DK 00438680
  605. LA R6,HOLDON RETURN FOR ON HRC101DK 00438720
  606. LA R7,HOLDOFF SET UP FOR 'OFF' HRC101DK 00438760
  607. BAL R14,TSTONOFF GO CHECK ARGUMENT HRC101DK 00438800
  608. * HRC101DK 00438840
  609. * IF RETURN HERE - HAVE BAD ARGUMENT HRC101DK 00438880
  610. * HRC101DK 00438920
  611. B LOADARG2 G0 SEND ERROR MESSAGE HRC101DK 00438960
  612. SPACE , HRC101DK 00439000
  613. HOLDON NI VMMLVL2,X'FF'-VMMNHOLD SET FLAG OFF HRC101DK 00439040
  614. B TONDONE CONTINUE HRC101DK 00439080
  615. SPACE , HRC101DK 00439120
  616. HOLDOFF OI VMMLVL2,VMMNHOLD FLAG FOR NO HOLD HRC101DK 00439160
  617. B TONDONE CONTINUE HRC101DK 00439200
  618. EJECT , HRC101DK 00439240
  619. STAMP EQU * HRC101DK 00439280
  620. LA R6,STMPON RETURN FOR ON HRC101DK 00439320
  621. LA R7,STMPOFF RETURN FOR OFF @V200820 00440000
  622. BAL R14,TSTONOFF CHECK FOR ON OR OFF @V200820 00441000
  623. * HRC101DK 00442190
  624. * IF RETURN HERE - HAVE BAD ARGUMENT HRC101DK 00442380
  625. * HRC101DK 00442570
  626. B LOADARG2 G0 SEND ERROR MESSAGE HRC101DK 00442760
  627. SPACE 00443000
  628. STMPON OI VMMLEVEL,VMMSTMP TURN ON TIME STAMP @V200820 00444000
  629. B TONDONE @V200820 00445000
  630. SPACE 00446000
  631. STMPOFF NI VMMLEVEL,255-VMMSTMP TURN OFF TIME STAMP @V200820 00447000
  632. B TONDONE @V200820 00448000
  633. SPACE 3 00449000
  634. GETNICB EQU * SUBROUTINE TO GET NICBLOK ADDRESS@V200820 00450000
  635. LH R2,VMTRMID 370X NCP RESOURCE REFERENCE @V200820 00451000
  636. N R2,F4095 STRIP OFF DEVICE CODE @V200820 00452000
  637. MH R2,=AL2(NICSIZE*8) CONVERT TO NICLIST INDEX @V200820 00453000
  638. AL R2,RDEVNICL @V200820 00454000
  639. BR R3 RETURN - NICBLOK IN GR2 @V200820 00455000
  640. EJECT 00456000
  641. SPACE 3 00457000
  642. MODE CL R4,F2 MUST BE ONLY 2 CHARS @V200930 00458000
  643. BNE LOADARG2 NO, ERROR @V200930 00459000
  644. CLC 0(2,R5),=C'CP' IS IT CP ?? @V200930 00460000
  645. BE MODCP YES, SET IT @V200930 00461000
  646. CLC 0(2,R5),=C'VM' IS IT VM ?? @V200930 00462000
  647. BNE LOADARG2 NO, ERROR @V200930 00463000
  648. NI VMMLEVEL,X'FF'-VMMCPENV CPMOD FLAG OFF @V200930 00464000
  649. B TONDONE DONE, GET NEXT @V200930 00465000
  650. MODCP OI VMMLEVEL,VMMCPENV SET CP MODE @V200930 00466000
  651. B TONDONE DONE, GET NEXT @V200930 00467000
  652. SPACE 3 00468000
  653. TONDONE OI SAVEWRK1,TERMDONE IND. THAT AT LEAST ONE ARG. PROCESS 00469000
  654. NI SAVEWRK1,255-(FIRSTARG+SECNDARG) TURN OFF 1ST AND 2ND 00470000
  655. B CFTARG1 GO SEE IF ANY MORE ARGUMENTS 00471000
  656. SPACE 2 00471100
  657. TSTCHAR EQU * @VA04451 00471300
  658. CL R4,F1 ONE CHAR IN ARGUMENT? @VA04451 00471500
  659. BNE TSTONOFF NO, TEST FOR ON/OFF @VA04451 00471700
  660. CLC 0(0,R5),=X'C1' POSSIBLY ALPHANUMERIC? @VA04451 00471900
  661. BL RETNR14 NO, VALID CHARACTER @VA04451 00472100
  662. CLC 0(0,R5),=X'D0' IS THIS SPECIAL CHARACTER? @V60A6B6 00472140
  663. BE RETNR14 YES, THEN VALID @V60A6B6 00472180
  664. CLC 0(0,R5),=X'E0' OTHER SPECIAL CHARACTER? @V60A6B6 00472220
  665. BE RETNR14 YES, VALID @V60A6B6 00472260
  666. CLC 0(0,R5),=X'F9' IS IT ALPHANUMERIC? @VA04451 00472300
  667. BH RETNR14 NO, VALID CHARACTER @VA04451 00472500
  668. B LOADARG2 SEND ERROR MSG @VA04451 00472700
  669. SPACE 2 00472900
  670. TSTONOFF EQU * 00473000
  671. CL R4,F1 LESS THAN 2 CHARACTERS @VA11392 00473050
  672. BNH LOADARG2 YES, GO SEND ERROR MESSAGE @VA11392 00473100
  673. BCTR R4,0 MINUS ONE FOR 'EX' 00476000
  674. EX R4,COMPOFF 'OFF' ???? 00477000
  675. BE RETOFF YES --- 00478000
  676. EX R4,COMPON 'ON' ???? 00479000
  677. BE RETON YES --- 00480000
  678. LA R4,1(,R4) RESTORE BYTE COUNT FOR ERROR MESSAGE 00481000
  679. B LOADARG2 GO SEND ERROR MESSAGE 00482000
  680. SPACE 00483000
  681. RETNR14 BR R14 RETURN FOR CHARACTER 00484000
  682. RETOFF BR R7 RETURN FOR 'OFF' 00485000
  683. RETON BR R6 RETURN FOR 'ON' 00486000
  684. SPACE 00487000
  685. COMPOFF CLC 0(0,R5),=C'OFF ' EXECUTED COMPARE 00488000
  686. COMPON CLC 0(0,R5),=C'ON ' 00489000
  687. EJECT 00490000
  688. TERMEXIT EXIT 00491000
  689. SPACE 4 00492000
  690. LOADARG2 LR R2,R4 LOAD LENGTH INTO R2 00493000
  691. LR R3,R5 LOAD ADDRESS OF BAD ARGUMENT 00494000
  692. SPACE 00495000
  693. CFT002 LR R0,R2 LENGTH 00496000
  694. LR R1,R3 ADDRESS 00497000
  695. LA R2,2 ERROR CODE 00498000
  696. B CALLERM . . . 00499000
  697. SPACE 00500000
  698. CFT006 EQU * DMKCFT006E INVALID DEVICE TYPE - @V200820 00501000
  699. SLR R1,R1 CLEAR PARM REGISTER @V200820 00502000
  700. LA R2,006(0) MESSAGE NUMBER TO GR2 @V200820 00503000
  701. SLR R0,R0 IF ANY DATA, WILL BE IN GR1 @V200820 00504000
  702. LH R8,VMVTERM DISP TO VIRTUAL CONSOLE VDEVBLOK @V200820 00505000
  703. LTR R8,R8 IS THERE ONE ? @V200820 00506000
  704. BM CALLERM NO -- MESSAGE WITH NO DATA @V200820 00507000
  705. AL R8,VMDVSTRT GET THE VDEVBLOK ADDRESS @V200820 00508000
  706. CALL DMKSCNVD COMPUTE 'CCU' FORM OF VADDR @V200820 00509000
  707. CALL DMKCVTBH CONVERT THE ADDRESS TO HEX 00510000
  708. ICM R1,8,X40FFS BLANK THE HIGH BYTE 00511000
  709. SLR R0,R0 ZIP GPR 0 00512000
  710. B CALLERM GO SEND THE ERROR MESSAGE 00513000
  711. SPACE 00514000
  712. CFT026 LA R2,26 ERROR CODE 00515000
  713. SR R1,R1 ZERO PARM REG 00516000
  714. SPACE 00517000
  715. CALLERM ICM R0,14,MODID+3 LOAD MODULE ID 00518000
  716. CALL DMKERMSG . . . 00519000
  717. * 00520000
  718. * DMKERM WILL RETURN DIRECTLY TO DMKCFM - NOT HERE -- 00521000
  719. * 00522000
  720. BRACKET EQU X'AD' LINE DEL CHARACTER FOR ASCII @VA09934 00522100
  721. EJECT 00523000
  722. LTORG 00524000
  723. EJECT 00525000
  724. PSA , @V306638 00526000
  725. COPY DEVTYPES @V306638 00527000
  726. COPY EQU @V306638 00528000
  727. COPY NETWORK @V306638 00529000
  728. COPY RBLOKS @V306638 00530000
  729. COPY SAVE @V306638 00531000
  730. SYSLOCS , @V306638 00532000
  731. COPY VMBLOK @V306638 00533000
  732. END 00534000