Table of Contents

NOTE

Table Of Contents

  • [00013] NOTE - ENTER DELIMITED LINES INTO FILE.
  • [00015] ENTER DELIMITED LINES INTO FILE.
  • [00110] SYMBOLS AND DATA.
  • [00168] COMMAND PROCESSORS.
  • [00170] BLOCK - WRITE BLOCK LETTERS TO FILE.
  • [00223] ENTER - PLACE COMMANDS FROM CALL COMMAND INTO
  • [00240] PLACE LINES FROM CALL COMMAND INTO SPECIFIED FILE.
  • [00289] SUBROUTINES.
  • [00291] CNW - CENTER NAME IN WORD.
  • [00320] CSP - CHECK FOR SUBSTITUTIBLE PARAMETERS.
  • [00434] EXP - EXPAND CHARACTERS.
  • [00479] ICP - INITIALIZE COMMAND PARAMETERS.
  • [00506] GJS - GET JOB SEQUENCE NAME.
  • [00529] WDL - WRITE DELIMITED LINES.

Source Code

NOTE.txt
  1. IDENT NOTE,FET
  2. ABS
  3. SST
  4. SYSCOM B1
  5.  
  6. ENTRY BLOCK
  7. ENTRY ENTER
  8. ENTRY NOTE
  9. ENTRY RFL=
  10.  
  11. *COMMENT NOTE - ENTER DELIMITED LINES INTO FILE.
  12. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
  13. TITLE NOTE - ENTER DELIMITED LINES INTO FILE.
  14. SPACE 4
  15. *** NOTE - ENTER DELIMITED LINES INTO FILE.
  16. * J.C.BOHNHOFF. 75/05/04.
  17. * W.F.ANSLEY. 77/02/03.
  18. * R.K.MYERS. 84/01/04.
  19. SPACE 4
  20. *** NOTE TAKES DELIMITED LINES FROM THE CALL COMMAND
  21. * AND WRITES THEM INDIVIDUALLY TO A FILE. THIS FILE MAY BE USED
  22. * AS A PROCEDURE.
  23. NOTE SPACE 4,45
  24. *** THE COMMAND -
  25. *
  26. * BLOCK(LFN,P1,P2)/BLINE 1/BLINE 2/BLINE N
  27. * OR
  28. * ENTER./COMMAND 1/COMMAND 2/COMMAND N
  29. * OR
  30. * NOTE(LFN,NR)/LINE 1/LINE 2/LINE N
  31. *
  32. * ASSUMED PARAMETERS.
  33. * LFN = *OUTPUT*.
  34. * NR OMITTED = AUTOMATIC REWIND BEFORE AND AFTER (*NOTE*).
  35. * P1 OMITTED = NO REWIND BEFORE (*BLOCK*).
  36. *
  37. * WHERE ) MAY BE PERIOD OR RIGHT PARENTHESIS.
  38. * LFN IS A FILE NAME TO RECEIVE THE LINES. IF ABSENT,
  39. * *OUTPUT* IS ASSUMED.
  40. * NR CAN EITHER BE *NR* OR *R*, DENOTING WHETHER THE
  41. * FILE SHOULD BE REWOUND BEFORE AND AFTER PROCESSING.
  42. * P1 CAN EITHER BE *R* OR *NR*, DENOTING WHETHER
  43. * THE FILE SHOULD BE REWOUND BEFORE PROCESSING.
  44. * P2 CAN BE ANY USER SPECIFIED CARRIAGE CONTROL
  45. * CHARACTER (ONLY THE FIRST CHARACTER IS USED), BUT
  46. * NO VALIDITY CHECKING IS PERFORMED. LITERALS ($-$)
  47. * OR THE WORD *SPACE* WILL ALSO BE ACCEPTED.
  48. * / MAY BE ANY CHARACTER TO DELIMIT THE INDIVIDUAL
  49. * COMMANDS. IT MUST IMMEDIATELY FOLLOW THE PERIOD
  50. * OR RIGHT PARENTHESIS. A RIGHT BLANK WILL BE
  51. * GENERATED FOR EACH OCCURRENCE OF CONSECUTIVE
  52. * DELIMITERS.
  53. * COMMAND I IS ANY VALID COMMAND. A
  54. * PERIOD IS APPENDED TO ANY COMMAND THAT DOES NOT
  55. * ALREADY HAVE A TERMINATOR (A *.* OR A *)*).
  56. * LINE I IS ANY TEXT. IT IS TREATED THE SAME AS A
  57. * COMMAND EXCEPT THAT A BLANK IS APPENDED TO
  58. * EACH LINE INSTEAD OF A PERIOD.
  59. * BLINE I IS ANY TEXT STRING OF UP TO 9
  60. * CHARACTERS IN LENGTH, WHICH IS TO BE PRINTED
  61. * IN EXPANDED FORMAT TO FILE LFN. THERE ARE
  62. * SPECIAL TEXT STRINGS FOR WHICH CURRENT DATA
  63. * ABOUT THE JOB WILL BE SUBSTITUTED. THESE ARE -
  64. *
  65. * STRING SUBSTITUTED DATA
  66. * ------ ----------- ----
  67. * DATE CURRENT DATE
  68. * JSN JOB SEQUENCE NAME
  69. * TIME CURRENT TIME
  70. * UJN USER JOB NAME
  71. * USER USER NAME
  72. *
  73. *
  74. * *ENTER* WRITES THE COMMANDS TO AN INTERNAL FILE
  75. * *ZZZZZG0* AND THEN EXECUTES A *ZZZZZG0.* COMMAND
  76. * TO PROCESS THE COMMANDS.
  77. *
  78. * FOR EXAMPLE -
  79. * ENTER./LDSET(LIB=ULIB)/LOAD(A)/LOAD(LGO)/NOGO.
  80. * RESULTS IN -
  81. * LDSET(LIB=ULIB)
  82. * LOAD(A)
  83. * LOAD(LGO)
  84. * NOGO.
  85. *
  86. * *NOTE* WRITES THE LINES TO A FILE.
  87. *
  88. * FOR EXAMPLE -
  89. * NOTE(MESSAGE)/ CANT GET THE FILE
  90. * RESULTS IN FILE MESSAGE CONTAINING -
  91. * CANT GET THE FILE
  92. SPACE 4
  93. *** DAYFILE MESSAGES ISSUED.
  94. *
  95. * * TOO MANY PARAMETERS.*
  96. * MORE THAN TWO PARAMETERS WERE SPECIFIED ON THE CALL
  97. * COMMAND.
  98. *
  99. * * NO TERMINATOR IN COMMAND CALL.*
  100. * NO TERMINATOR WAS FOUND BEFORE THE LEADING DELIMITER
  101. * OF THE CALL COMMAND.
  102. *
  103. * * INCORRECT -NR- PARAMETER.*
  104. * A PARAMETER OTHER THAN *NR*, *R* OR NULL WAS PASSED
  105. * TO *NOTE* AS THE SECOND PARAMETER.
  106. *
  107. * * INCORRECT -R/NR- PARAMETER.*
  108. * A PARAMETER OTHER THAN *R*, *NR* OR NULL WAS PASSED
  109. * TO *BLOCK* AS THE SECOND PARAMETER.
  110. TITLE SYMBOLS AND DATA.
  111. * COMMON DECKS.
  112.  
  113.  
  114. *CALL COMCMAC
  115. *CALL COMSQAC
  116. SPACE 4
  117. * SYMBOL DEFINITIONS.
  118.  
  119.  
  120. PBUFL EQU 3 *QAC*/*PEEK* BUFFER LENGTH
  121. SBUFL EQU 3001B SCRATCH/OUTPUT BUFFER LENGTH
  122. SPACE 4
  123. * FET.
  124.  
  125.  
  126. ORG 110B
  127. FET BSS 0
  128.  
  129. S BSS 0 SCRATCH
  130. ZZZZZG0 FILEB SBUF,SBUFL
  131. SPACE 4
  132. * DATA LOCATIONS.
  133.  
  134.  
  135. BLKF CON 0 *BLOCK* FLAG
  136. CCCH DATA 1L1 CARRIAGE CONTROL CHARACTER
  137. DATE CON 0 CURRENT DATE
  138. JSNM CON 0 JOB SEQUENCE NAME
  139. NLIP CON 0 NUMBER OF LINES IN PAGE
  140. NR CON 0 NO REWIND FLAG
  141. TIME CON 0 CURRENT TIME
  142. UJNM CON 0 USER JOB NAME
  143. USER CON 0 USER NAME
  144. QACB SPACE 4,10
  145. * *QAC* PARAMETER BLOCK.
  146.  
  147. QACB VFD 50/0,9/PKFC,1/0 REQUEST PREFIX PORTION
  148. VFD 36/0,6/11,18/PBUF
  149. VFD 42/0,18/PBUF
  150. VFD 42/0,18/PBUF
  151. VFD 42/0,18/PBUF+PBUFL
  152. QBSC VFD 60/0 SELECTION CRITERIA PORTION
  153. VFD 60/0
  154. VFD 60/100B
  155. VFD 12/2B,48/0
  156. VFD 60/0
  157. VFD 60/0
  158. VFD 60/0
  159. QBPF VFD 60/-0 PEEK FUNCTION PORTION
  160. VFD 12/-0,48/0
  161. VFD 48/0,12/UJPB+JSPB JSN AND USER JOBNAME
  162. VFD 60/0
  163.  
  164.  
  165. * *QAC*/*PEEK* BUFFER.
  166.  
  167. PBUF BSSZ PBUFL
  168. TITLE COMMAND PROCESSORS.
  169. BLOCK SPACE 4,10
  170. ** BLOCK - WRITE BLOCK LETTERS TO FILE.
  171.  
  172.  
  173. BLOCK BSS 0 ENTRY
  174. SB1 1
  175. SX6 B1+
  176. SA6 BLKF SET *BLOCK* FLAG
  177. RJ ICP INITIALIZE COMMAND PARAMETERS
  178. ZR B6,BLO0 IF NO PARAMETERS
  179. RJ POP READ FILE NAME PARAMETER
  180. NZ X6,BLO1 IF PARAMETER PRESENT
  181. BLO0 SA1 =0LOUTPUT SET DEFAULT FILE NAME
  182. BX6 X1
  183. BLO1 SX7 B1 SET STATUS
  184. BX6 X7+X6
  185. SA6 S SET FILE NAME
  186. ZR B6,BLO3 IF NO MORE PARAMETERS
  187. RJ POP READ *R/NR* PARAMETER
  188. ZR X6,BLO2 IF NULL PARAMETER
  189. SX3 2RNR
  190. SX2 1RR
  191. LX3 -12
  192. LX2 -6
  193. BX3 X6-X3
  194. BX2 X6-X2 CHECK IF *R*
  195. ZR X3,BLO2 IF *NR* SPECIFIED
  196. NZ X2,BLO4 IF NOT *R*
  197. REWIND S,R
  198. BLO2 ZR B6,BLO3 IF NO MORE PARAMETERS
  199. RJ POP READ CARRIAGE CONTROL PARAMETER
  200. ZR X6,BLO3 IF NULL PARAMETER SPECIFIED
  201. MX1 6
  202. BX6 X6*X1 ISOLATE TO 1 CHARACTER
  203. SA6 CCCH SET USER SPECIFIED CARRIAGE CONTROL
  204. BLO3 GETPAGE BLOA GET PAGE SIZE PARAMETERS
  205. SA1 BLOA
  206. MX6 -8
  207. LX1 -20
  208. BX6 -X6*X1 NUMBER OF LINES ON PAGE
  209. SA6 NLIP
  210. WRITEW S,CCCH,1 WRITE CARRIAGE CONTROL CHARACTER
  211. SX7 1R SET TERMINATOR
  212. RJ WDL WRITE DELIMITED LINES
  213. ENDRUN
  214.  
  215. * PROCESS INCORRECT PARAMETERS.
  216.  
  217. BLO4 MESSAGE (=C* INCORRECT -R/NR- PARAMETER.*),,R
  218. ABORT
  219.  
  220.  
  221. BLOA BSS 2 *GETPAGE* PARAMETER BLOCK
  222. ENTER SPACE 4,10
  223. ** ENTER - PLACE COMMANDS FROM CALL COMMAND INTO
  224. * FILE *ZZZZZG0*, AND THEN CALL FILE *ZZZZZG0*.
  225.  
  226.  
  227. ENTER BSS 0 ENTRY
  228. SB1 1
  229. RJ ICP INITIALIZE COMMAND PARAMETERS
  230. REWIND S,R REWIND SCRATCH FILE
  231. WRITEW S,ENTA,ENTAL WRITE PROCEDURE HEADER
  232. SX7 1R. SET TERMINATOR
  233. RJ WDL WRITE DELIMITED LINES
  234. EXCST (=C*ZZZZZG0.*) ENTER CALL COMMAND
  235.  
  236. ENTA DATA C*.PROC,ZZZZZG0.*
  237. DATA C*$RETURN,ZZZZZG0.*
  238. ENTAL EQU *-ENTA
  239. NOTE SPACE 4
  240. ** NOTE - PLACE LINES FROM CALL COMMAND INTO SPECIFIED FILE.
  241.  
  242.  
  243. NOTE BSS 0 ENTRY
  244. SB1 1
  245. RJ ICP INITIALIZE COMMAND PARAMETERS
  246. ZR B6,NOT1 IF NO PARAMETERS
  247. RJ POP READ FILE NAME PARAMETER
  248. NZ X6,NOT2 IF FILE NAME PRESENT
  249. NOT1 SA1 =0LOUTPUT SET DEFAULT FILE NAME
  250. BX6 X1
  251. NOT2 SA2 S SET NAME
  252. MX0 42
  253. BX7 -X0*X2 FILE STATUS
  254. BX6 X6+X7
  255. SA6 A2
  256. ZR B6,NOT3 IF NO MORE PARAMETERS
  257. RJ POP READ *NR* PARAMETER
  258. NZ B6,NOT6 IF TOO MANY PARAMETERS
  259. ZR X6,NOT3 IF NULL PARAMETER
  260. SX3 1RR
  261. SX2 2RNR
  262. LX3 -6
  263. LX2 -12
  264. BX3 X6-X3 CHECK IF *R*
  265. BX2 X6-X2 CHECK IF *NR*
  266. ZR X3,NOT3 IF *R*
  267. NZ X2,NOT7 IF NOT *NR*
  268. SX7 1R SET TERMINATOR
  269. SA7 NR INDICATE NO REWIND IN EFFECT
  270. EQ NOT4
  271. *
  272. NOT3 REWIND S,R
  273. SX7 1R
  274. NOT4 RJ WDL WRITE DELIMITED LINES
  275. SA1 NR
  276. NZ X1,NOT5 IF NO REWIND SELECTED
  277. REWIND S
  278. NOT5 ENDRUN
  279.  
  280. * PROCESS TOO MANY PARAMETERS.
  281.  
  282. NOT6 MESSAGE (=C* TOO MANY PARAMETERS.*),,R
  283. ABORT
  284.  
  285. * PROCESS INCORRECT PARAMETERS
  286.  
  287. NOT7 MESSAGE (=C* INCORRECT -NR- PARAMETER.*),,R
  288. ABORT
  289. TITLE SUBROUTINES.
  290. CNW SPACE 4,10
  291. ** CNW - CENTER NAME IN WORD.
  292. *
  293. * ENTRY (X1) = NAME (LEFT JUSTIFIED, ZERO FILLED).
  294. *
  295. * EXIT (X6) = CENTERED NAME.
  296. *
  297. * USES X - 1, 7.
  298. * B - 2.
  299. *
  300. * CALLS SFN.
  301.  
  302.  
  303. CNW SUBR ENTRY/EXIT
  304. RJ SFN SPACE FILL NAME
  305. ZR X7,CNWX IF 10-CHARACTER NAME
  306. CX7 X7 NUMBER OF BITS IN NAME
  307. SX1 6
  308. IX7 X7/X1 NUMBER OF CHARACTERS IN NAME
  309. SX1 10 NUMBER OF CHARACTERS IN WORD
  310. IX7 X1-X7
  311. AX7 1 NUMBER OF CHARACTERS TO RIGHT SHIFT
  312. LX7 1
  313. SB2 X7
  314. LX7 1
  315. SB2 X7+B2 NUMBER OF BITS TO RIGHT SHIFT
  316. SB2 B2-60
  317. AX6 B2 CENTER NAME (CIRCULAR LEFT SHIFT)
  318. EQ CNWX RETURN
  319. CSP SPACE 4,15
  320. ** CSP - CHECK FOR SUBSTITUTIBLE PARAMETERS.
  321. *
  322. * ENTRY (B6) = FWA OF DELIMITED STRING TO TEST.
  323. * (B7) = COUNT OF CHARACTERS IN STRING.
  324. *
  325. * EXIT (X4) = PACKED WORD TO BE PRINTED.
  326. *
  327. * USES X - 1, 2, 3, 4, 5, 6.
  328. * A - 1, 2, 4, 6.
  329. * B - 2, 3, 4, 5.
  330. *
  331. * CALLS CNW, GJS.
  332. *
  333. * MACROS CLOCK, DATE, SYSTEM, USERNUM.
  334.  
  335.  
  336. CSP SUBR ENTRY/EXIT
  337. SB4 B6
  338. SB5 60
  339. BX1 X1-X1
  340. SB2 10 MAXIMUM CHARACTERS
  341. SB3 B7-2
  342. LT B3,B2,CSP1 IF CORRECT NUMBER OF CHARACTERS
  343. SB3 9 RESET CHARACTER COUNT
  344. CSP1 SA2 B4 GET NEXT CHARACTER
  345. LX1 6
  346. BX1 X1+X2 PACK CHARACTER
  347. SB4 B4+B1
  348. SB5 B5-6 DECREMENT SHIFT COUNT
  349. SB3 B3-B1 DECREMENT CHARACTER COUNT
  350. PL B3,CSP1 IF MORE CHARACTERS
  351. LX1 B5 LEFT JUSTIFY STRING
  352. SA2 CSPA
  353. MX3 42
  354. CSP2 BX6 X3*X2 CHECK FOR SUBSTITUTIBLE PARAMETER
  355. BX6 X1-X6
  356. ZR X6,CSP3 IF SUBSTITUTIBLE PARAMETER FOUND
  357. SA2 A2+B1
  358. NZ X2,CSP2 IF NOT AT END OF MATCH TABLE
  359.  
  360. * SPECIFIED STRING NOT FOUND IN TABLE.
  361.  
  362. RJ CNW CENTER STRING ON LINE
  363. BX4 X6
  364. EQ CSPX RETURN
  365.  
  366. * CALL SUBSTITUTION PROCESSOR.
  367.  
  368. CSP3 SB2 X2 GET PROCESSOR ADDRESS
  369. JP B2 PROCESS SUBSTITUTION
  370.  
  371. * GET CURRENT DATE.
  372.  
  373. CSP4 SA4 DATE
  374. NZ X4,CSPX IF DATE ALREADY AVAILABLE
  375. DATE DATE
  376. SA1 DATE
  377. SX6 1R &1R. CHANGE LAST CHARACTER TO SPACE
  378. BX6 X1-X6
  379. SA6 A1
  380. EQ CSP4 RETURN DATE
  381.  
  382. * GET CURRENT TIME.
  383.  
  384. CSP5 SA4 TIME
  385. NZ X4,CSPX IF TIME ALREADY AVAILABLE
  386. CLOCK TIME
  387. SA1 TIME
  388. SX6 1R &1R. CHANGE LAST CHARACTER TO SPACE
  389. BX6 X1-X6
  390. SA6 A1
  391. EQ CSP5 RETURN TIME
  392.  
  393. * GET USER NAME.
  394.  
  395. CSP6 SA4 USER
  396. NZ X4,CSPX IF USER NAME ALREADY AVAILABLE
  397. USERNUM USER
  398. SA1 USER
  399. RJ CNW CENTER USER NAME IN WORD
  400. SA6 A1
  401. EQ CSP6 RETURN USER NAME
  402.  
  403. * GET JSN.
  404.  
  405. CSP7 SA4 JSNM
  406. NZ X4,CSPX IF JSN ALREADY AVAILABLE
  407. RJ GJS GET JSN
  408. EQ CSP7 RETURN JSN
  409.  
  410. * GET UJN.
  411.  
  412. CSP9 SA4 UJNM
  413. NZ X4,CSPX IF UJN ALREADY AVAILABLE
  414. SA1 JSNM
  415. NZ X1,CSP10 IF JSN ALREADY AVAILABLE
  416. RJ GJS GET JSN FOR *QAC* CALL
  417. CSP10 SYSTEM QAC,R,QACB CALL *QAC* FOR UJN
  418. SA1 PBUF+1
  419. MX3 42
  420. BX1 X3*X1 ISOLATE UJN
  421. RJ CNW CENTER UJN IN WORD
  422. SA6 UJNM
  423. EQ CSP9 RETURN UJN
  424.  
  425.  
  426. CSPA BSS 0 TABLE OF SUBSTITUTION PROCESSORS
  427. VFD 42/0LDATE,18/CSP4
  428. VFD 42/0LTIME,18/CSP5
  429. VFD 42/0LUSER,18/CSP6
  430. VFD 42/0LJSN,18/CSP7
  431. VFD 42/0LUJN,18/CSP9
  432. CON 0
  433. EXP SPACE 4,20
  434. ** EXP - EXPAND CHARACTERS.
  435. *
  436. * EXPAND EACH CHARACTER OF A TEN CHARACTER STRING INTO A
  437. * PATTERN OF CHARACTERS IN A 10X10 MATRIX, AND WRITE THE
  438. * EXPANSION ONTO FILE *S*. CERTAIN SPECIAL STRINGS WILL
  439. * HAVE VALUES SUBSTITUTED BEFORE EXPANSION (SEE *CSP*).
  440. * A PAGE EJECT WILL BE WRITTEN IF THE PAGE IS FULL.
  441. *
  442. * ENTRY (B6) = FWA OF DELIMITED STRING TO EXPAND.
  443. * (B7) = COUNT OF CHARACTERS IN STRING.
  444. *
  445. * EXIT EXPANDED BLOCK LETTERS WRITTEN TO FILE.
  446. *
  447. * USES X - 1, 2, 3, 4, 5, 6.
  448. * A - 1, 2, 6.
  449. *
  450. * CALLS BAN, CSP.
  451. *
  452. * MACROS WRITEW.
  453.  
  454.  
  455. EXP SUBR ENTRY/EXIT
  456. RJ CSP CHECK FOR SUBSTITUTIBLE PARAMETERS
  457. SA2 LBUF EXPAND LINE TO *LBUF*
  458. RJ BAN
  459. SX5 A2-LBUF LENGTH OF BUFFER
  460. SA1 EXPA UPDATE LINE COUNT
  461. SX6 X1+/COMCBAN/LNCH+2
  462. SA2 NLIP
  463. SA6 A1
  464. ZR X1,EXP2 IF TOP OF FIRST PAGE
  465. IX2 X2-X6
  466. PL X2,EXP1 IF ROOM ON CURRENT PAGE
  467. SX6 /COMCBAN/LNCH+2 RESET LINE COUNT FOR NEW PAGE
  468. SA6 A1
  469. WRITEW S,(=2L1 ),1 ISSUE PAGE EJECT
  470. EQ EXP2 WRITE EXPANDED LINE TO FILE
  471.  
  472. EXP1 WRITEW S,(=2L0 ),1 ISSUE DOUBLE SPACE
  473. EXP2 WRITEW S,LBUF,X5 WRITE EXPANDED LINE TO FILE
  474. EQ EXPX RETURN
  475.  
  476.  
  477. EXPA CON 0 NUMBER OF LINES ALREADY ON CURRENT PAGE
  478. ICP SPACE 4,15
  479. ** ICP - INITIALIZE COMMAND PARAMETERS.
  480. *
  481. * ICP INITIALIZES THE COMMAND STRING BUFFER FOR SUBSEQUENT
  482. * EXTRACTION OF PARAMETERS VIA *POP*.
  483. *
  484. * EXIT (B6) .EQ. 0 IF TERMINATOR ENCOUNTERED.
  485. * .NE. 0 = INDEX TO NEXT CHARACTER IN BUFFER.
  486. * (USCB) = EXPANDED COMMAND, 1 CHARACTER PER WORD.
  487. *
  488. * USES X - 1.
  489. * A - 1.
  490. * B - 2, 6.
  491. *
  492. * CALLS POP, USB.
  493.  
  494.  
  495. ICP2 RJ POP SKIP PAST COMMAND NAME
  496.  
  497. ICP SUBR ENTRY/EXIT
  498. SB2 CCDR COMMAND
  499. RJ USB UNPACK DATA BLOCK TO STRING BUFFER
  500. ICP1 SA1 B6+ SKIP PREFIX $, /, SPACE
  501. SX1 X1-1R9-1
  502. NG X1,ICP2 IF ALPHANUMERIC CHARACTER
  503. SB6 B6+1
  504. EQ ICP1 CHECK NEXT CHARACTER
  505. GJS SPACE 4,15
  506. ** GJS - GET JOB SEQUENCE NAME.
  507. *
  508. * EXIT (QBSC+2) SET WITH JSN FOR *QAC* CALL.
  509. * (JSNM) = CENTERED JSN.
  510. *
  511. * USES X - 1, 6.
  512. * A - 1, 6.
  513. *
  514. * CALLS CNW.
  515. *
  516. * MACROS GETJN.
  517.  
  518.  
  519. GJS SUBR ENTRY/EXIT
  520. GETJN QBSC+2 GET JSN
  521. SA1 QBSC+2 SET JSN FOR POSSIBLE *QAC* CALL
  522. SX6 100B SET JSN FLAG
  523. BX6 X1+X6
  524. SA6 A1
  525. RJ CNW CENTER JSN
  526. SA6 JSNM SET CENTERED JSN
  527. EQ GJSX RETURN
  528. WDL SPACE 4,20
  529. ** WDL - WRITE DELIMITED LINES.
  530. *
  531. * ENTRY (X7) = TERMINATOR TO BE APPENDED TO EACH LINE.
  532. * (S) SET WITH PROPER FILE NAME.
  533. *
  534. * EXIT FILE WRITTEN WITH EOR.
  535. *
  536. * USES X - ALL.
  537. * A - 0, 1, 2, 5, 6, 7.
  538. * B - 2, 5, 6, 7.
  539. *
  540. * CALLS EXP.
  541. *
  542. * MACROS ABORT, MESSAGE, WRITER, WRITES, WRITEW.
  543.  
  544.  
  545. WDL SUBR ENTRY/EXIT
  546. SA7 WDLA SAVE TERMINATOR
  547. SA2 USBC LWA OF COMMAND IN STRING BUFFER
  548. MX6 -1 ASSURE STRING TERMINATION
  549. SA0 B0 CLEAR LINE COUNT
  550.  
  551. * REMOVE TRAILING BLANKS FROM COMMAND.
  552.  
  553. WDL0.1 SA1 X2+
  554. SX2 X2-1
  555. SX1 X1-1R
  556. ZR X1,WDL0.1 IF BLANK CHARACTER
  557.  
  558. * FIND BEGINNING OF LINES TO BE WRITTEN.
  559.  
  560. SA5 USBB FIND DELIMITER
  561. SA6 X2+2
  562. SA6 X2+3
  563. WDL1 NG X5,WDL11 IF NO TERMINATION
  564. SX6 X5-1R.
  565. SX7 X5-1R)
  566. SA5 A5+1
  567. ZR X6,WDL2 IF TERMINATOR
  568. NZ X7,WDL1 IF NOT TERMINATOR
  569. WDL2 BX0 X5 DELIMITER
  570. SA5 A5+B1 FIRST CHARACTER OF FIRST LINE
  571. BX6 X0
  572. SB6 A5 SET FWA OF LINE
  573. SA6 WDLB SAVE DELIMITER
  574. SB5 B0 INITIALIZE LINE TERMINATOR FLAG
  575.  
  576. * WRITE DELIMITED LINES.
  577.  
  578. WDL3 NG X5,WDL8 IF END OF STRING
  579. BX6 X5-X0 CHECK DELIMITER
  580. SX4 X5-1R.
  581. SX3 X5-1R)
  582. ZR X4,WDL4 IF TERMINATOR
  583. NZ X3,WDL5 IF NOT TERMINATOR
  584. WDL4 SB5 1 INDICATE TERMINATOR IN THIS LINE
  585. WDL5 SA5 A5+1
  586. NZ X6,WDL3 IF NOT DELIMITER
  587. SA1 WDLA TERMINATE LINE
  588. SB7 A5 WRITE LINE
  589. BX7 X1
  590. SB7 B7-B6 LENGTH OF LINE
  591. SA7 A5-B1
  592. SA1 BLKF
  593. NZ X1,WDL7 IF *BLOCK* CALL
  594. ZR B5,WDL6 IF LINE TERMINATOR NOT FOUND
  595. SB7 B7-1 DO NOT ADD TERMINATOR
  596. WDL6 WRITES S,B6,B7
  597. SB6 A5 SET FWA OF LINE
  598. SB5 B0 INITIALIZE LINE TERMINATOR FLAG
  599. EQ WDL3 LOOP TO STRING TERMINATOR
  600.  
  601. WDL7 RJ EXP EXPAND CHARACTERS
  602. SA5 A5 RESTORE (X5)
  603. SA2 WDLB RESTORE DELIMITER
  604. SB6 A5 SET FWA OF LINE
  605. BX0 X2
  606. EQ WDL3 LOOP TO STRING TERMINATOR
  607.  
  608. * WRITE LAST LINE.
  609.  
  610. WDL8 SB7 A5+B1 WRITE LAST LINE
  611. SA1 WDLA TERMINATE LINE
  612. SB7 B7-B6 LENGTH OF LINE
  613. BX7 X1
  614. SA7 A5
  615. SA1 BLKF
  616. NZ X1,WDL10 IF *BLOCK* CALL
  617. ZR B5,WDL9 IF LINE TERMINATOR NOT FOUND
  618. SB7 B7-1 DO NOT ADD LINE TERMINATOR
  619. WDL9 WRITES S,B6,B7
  620. WRITER S,R END FILE
  621. EQ WDLX RETURN
  622.  
  623. WDL10 RJ EXP EXPAND CHARACTERS
  624. WRITEW S,(=2L0 ),1 ISSUE DOUBLE SPACE
  625. WRITER S,R END FILE
  626. EQ WDLX RETURN
  627.  
  628. WDL11 MESSAGE (=C* NO TERMINATOR IN COMMAND CALL.*)
  629. ABORT
  630.  
  631. WDLA CON 0 HOLDS LINE TERMINATOR
  632. WDLB CON 0 STRING DELIMITER
  633. SPACE 4
  634. * COMMON DECKS.
  635.  
  636.  
  637. LIST X
  638. SMCH$ EQU 1 ENCODE SMALL CHARACTERS
  639. *CALL COMCBAN
  640. LIST *
  641. *CALL COMCCIO
  642. *CALL COMCCPM
  643. *CALL COMCSFN
  644. *CALL COMCSYS
  645. *CALL COMCUSB
  646. LIT EQ 1 ALLOW LITERAL PARAMETERS
  647. *CALL COMCPOP
  648. *CALL COMCWTS
  649. *CALL COMCWTW
  650. LIST X
  651. *CALL COMTBAN
  652. LIST *
  653. SPACE 4
  654. USE BUFFER
  655. SPACE 4
  656. * BUFFER.
  657.  
  658.  
  659. SBUF EQU * SCRATCH BUFFER
  660. LBUF EQU SBUF+SBUFL LINE BUFFER
  661. RFL= EQU LBUF+134D
  662.  
  663.  
  664. END