Retro1.org codex

User Tools

Site Tools

Trace: • DOCPRT
plato:source:plaopl:docprt

Table of Contents

DOCPRT

Table Of Contents

  • [00076] LOGIC -
  • [00978] CONCAT - CONCATENATE STRING

Source Code

DOCPRT.txt 
  1. DOCPRT
  2. * /---   FILE TYPE = E
  3. * /---   BLOCK      DOCPRT     00 000   80/09/16  10.18 
  4.           PROGRAM DOCPRT(OUTPUT,PARAM,DEBUG=OUTPUT,TAPE4=PARAM) 
  5. *****     DOCPRT
  6. * 
  7. *         PROGRAM TO PRINT DOCUMENTOR FILES.
  8. * 
  9. *         PRINTS NEW FORMAT (NAMESET TYPE) DOCUMENTOR FILES.
  10. *         ALLOWS SELECTION OF PARAMETERS AT THE SUBSECTION
  11. *         LEVEL, ALONG WITH A NUMBER OF OTHER CONTROLS. 
  12. * 
  13. * 
  14. **
  15. *         FOR THE FORMAT OF DOCUMENTOR FILES, SEE THE 
  16. *         DOCUMENT -DOCSPEC-. 
  17. * 
  18. * 
  19. * 
  20. **        DATA STRUCTURES 
  21. * 
  22. *         COMMON /TITLES/ 
  23. **
  24. *         HOLDS THE TITLES OF THE CURRENT MAJOR SECTION.
  25. * 
  26. * 
  27. *         COMMON /SECT/ 
  28. **
  29. *         HOLDS THE SECTION CURRENTLY BEING PRINTED.
  30. * 
  31. * 
  32. *         COMMON /MISC/ 
  33. **
  34. *         MISC INFO FOR THE DOCUMENT (TITLES, ETC).  THE
  35. *         SECOND RECORD OF THE MISC INFO NAME.  MUST
  36. *         CORRESPOND TO THE DEFINES ON PLATO. 
  37. * 
  38. * 
  39. * 
  40. *         COMMON /DIREC/
  41. **
  42. *         HOLDS THE NAMESET DIRECTORY FOR PLATLIB ROUTINES. 
  43. * 
  44. * 
  45. *         COMMON /PARAM/
  46. **
  47. *         PARAMETERS USED TO CONTROL PRINTS.  READ IN FROM
  48. *         AN AUXILLIARY FILE WHEN THE PRINT IS INITIALIZED. 
  49. * 
  50. * 
  51. * 
  52. *         COMMON /PGNO/ 
  53. **
  54. *         PAGE NUMBERS OF SECTIONS, GENERATED DURING PRINT. 
  55. * 
  56. * 
  57. * /---   BLOCK      DOCPRT     00 000   84/02/14  22.34 
  58. * 
  59. * 
  60. *         COMMON /PRINT/
  61. **
  62. *         PRINT CONTROLS.  USED IN CONJUNCTION WITH */
  63. *         CONTROLS TO PRODUCE PRINTS. 
  64. * 
  65. * 
  66. * 
  67. * 
  68. ****
  69. *CALL DOCPRTC 
  70. ****
  71. * 
  72. * 
  73.           LOGICAL SECTBIT 
  74.           INTEGER NAME(3) 
  75. * /---   BLOCK      DOCPRT     00 000   84/02/14  22.35 
  76. **        LOGIC - 
  77. * 
  78. *         ATTACH THE DOCUMENT, CHECK FOR CORRECT FILE TYPE. 
  79. * 
  80.           CALL EXECARG(FNAME) 
  81.           CALL ATTACH(DIR,FNAME,0,IERR) 
  82.           IF (IERR.NE.-1) GOTO 5000 
  83.           IF ((IFTYPE(DIR).NE."DOCUMENT Q") .AND. 
  84.      1        (IFTYPE(DIR).NE."NAMESET  K"))
  85.      2           GOTO 5000
  86. **
  87. *         SETUP FOR PRINTING. 
  88. C 
  89. C         OUTPUT ACCOUNTING DAYFILE MESSAGE.
  90. C 
  91.           CALL ACCT 
  92. C 
  93. C         READ SELECTION BITS 
  94. C 
  95.           READ   (4,1001) SECBITS(1)
  96.           READ   (4,1001) SECBITS(2)
  97.  1001     FORMAT(O20) 
  98. * 
  99.           PRTP   =SECTBIT(100)
  100.           ABSTR  =SECTBIT(101)
  101.           OUTLINE=SECTBIT(102)
  102.           PRTEXT =SECTBIT(103)
  103. C 
  104. C         INITIALIZE PROGRAM PARAMETERS.
  105. C 
  106.           CALL PINIT
  107.           MS=-1 
  108. C 
  109. C         SETNAME TO THE MISC INFO NAME.
  110. C 
  111.           NAME(1)=5L;MISC 
  112.           NAME(2)=0 
  113.           NAME(3)=0 
  114.           CALL SETNAME(DIR,NAME,IERR) 
  115.           IF (IERR.NE.-1) GOTO 5000 
  116.           IF (IRECS(DIR).NE.2) GOTO 5000
  117.           CALL NDATAIN(DIR,2,DOCTTL1(1),1)
  118.           IF (IERR.NE.-1) CALL ERROR("DATAIN",IERR) 
  119. **
  120. *         PRINT THE TITLE PAGE IF SELECTED. 
  121. * 
  122.           IF (PRTP) CALL TTLPAGE
  123. **
  124. *         PRINT THE ABSTRACT IF SELECTED. 
  125. * 
  126.           IF (ABSTR) CALL ABSTRCT 
  127. **
  128. *         SETUP PAGE NUMBERS AND PAGE TITLE.
  129. * 
  130.           IPGNO=1 
  131.           DO 200 I=1,10 
  132.           PTITLE(I)=PGHDRE(I) 
  133.   200     CONTINUE
  134.           CALL CLEAN(PTITLE,10) 
  135. **
  136. *         PRINT THE TEXT OF EACH SECTION, IF TEXT SELECTED
  137. *         AND THE SECTION SELECTED. 
  138. * 
  139.           IF (PRTEXT) CALL PTEXT
  140. **
  141. *         PRINT THE OUTLINE IF SELECTED.
  142. * 
  143.           IF (OUTLINE) CALL OUTLIN
  144. C 
  145. C         DONE WITH PRINT.  DETACH THE FILE AND LEAVE.
  146. C 
  147.           CALL DETACH(DIR)
  148.           STOP
  149. C 
  150. C         ERROR MESSAGE IF NOT A DOCUMENT.
  151. C 
  152.  5000     PRINT *,"FILE ",FNAME," IS NOT A DOCUMENTOR FILE."
  153.           CALL DETACH(DIR)
  154.           STOP
  155. C 
  156.           END 
  157. * /---   BLOCK      TTLPAGE    00 000   80/07/31  13.21 
  158.           SUBROUTINE TTLPAGE
  159. **        TTLPAGE 
  160. * 
  161. *         PRINT THE TITLE PAGE OF THE CURRENT DOCUMENT. 
  162. * 
  163. C 
  164. C         COMMON DECKS. 
  165. C 
  166. *CALL,DOCPRTC 
  167. C 
  168. C         HLINES = .TRUE. IF THE 2 LINE HEADER EXISTS.
  169. C         INTRO  = .TRUE. IF AN INTRODUCTION EXISTS.
  170. C 
  171.           LOGICAL HLINES,INTRO
  172.           INTEGER NAME(3) 
  173. C 
  174. C         CHECK IF THERE IS A TITLE PAGE.  FIRST CHECK FOR
  175. C         HEADER LINES EXISTING.
  176. C 
  177. C         THE HEADER LINE CHECK SHOULD USE A BITCNT FUNCTION
  178. C         SOMEDAY.
  179. C 
  180.           HLINES=(DOCTTL1(1).NE.0).OR.((DOCTTL1(1).AND.MASK(30)).NE.0)
  181. C 
  182.           NAME(1)=7L;AUTHOR 
  183.           NAME(2)=NAME(3)=0 
  184.           CALL SETNAME(DIR,NAME,IERR) 
  185.           INTRO=(IERR.EQ.-1)
  186. C 
  187.           IF (.NOT.(HLINES.OR.INTRO)) RETURN
  188. C 
  189. C         FEED DOWN 10 SPACES.
  190. C 
  191.           CALL NEWPAGE
  192.           CALL BLANKLN(10)
  193. C 
  194. C         CHECK IF HEADER LINES EXIST.  IF SO, PRINT THEM.
  195. C 
  196.           IF (HLINES) GOTO 100
  197.           CALL BLANKLN(6) 
  198.           GOTO 200
  199. C 
  200.   100     CONTINUE
  201.           CALL CLEAN(DOCTTL1,5) 
  202.           CALL CLEAN(DOCTTL2,5) 
  203.           PRINT 2000,(DOCTTL1(I),I=1,5),(DOCTTL2(I),I=1,5)
  204.  2000     FORMAT (9X,5(10H**********),4H****/ 
  205.      1            9X,1H*,52X,1H*/ 
  206.      2            9X,2H* ,5A10/ 
  207.      2            1H+,61X,1H*/
  208.      3            9X,2H* ,5A10/ 
  209.      3            1H+,61X,1H*/
  210.      4            9X,1H*,52X,1H*/ 
  211.      5            9X,5(10H**********),4H****/)
  212. C 
  213.   200     CONTINUE
  214. C 
  215. C         NOW PRINT THE CURRENT DATE. 
  216. C 
  217.           CALL BLANKLN(6) 
  218.           CALL DATE(IDATE)
  219.           PRINT 2001,IDATE
  220.  2001     FORMAT (9X,30X,A10) 
  221. C 
  222. C         PRINT THE INTRODUCTION, IF ANY. 
  223. C 
  224.           IF (.NOT.INTRO) RETURN
  225. C 
  226.           CALL BLANKLN(10)
  227.           CALL NDATAIN(DIR,1,SECTION,IRECS(DIR),IERR) 
  228.           IF (IERR.NE.-1) CALL ERROR("DATAIN",IERR) 
  229. C 
  230.           CALL PRSECT 
  231. C 
  232.           RETURN
  233.           END 
  234. * /---   BLOCK      ABSTRCT    00 000   80/07/31  13.21 
  235.           SUBROUTINE ABSTRCT
  236. **        ABSTRCT 
  237. * 
  238. *         PRINT THE DOCUMENT ABSTRACT, IF ANY.
  239. * 
  240. *         READS THE ABSTRACT AND PRINTS IT ON A NEW PAGE. 
  241. * 
  242. * 
  243. *CALL,DOCPRTC 
  244.           INTEGER NAME(3) 
  245. C 
  246. C         SETNAME TO THE ABSTRACT NAME. 
  247. C 
  248.           NAME(1)=5L;DESC 
  249.           NAME(2)=0 
  250.           NAME(3)=0 
  251.           CALL SETNAME(DIR,NAME,IERR) 
  252.           IF (IERR.NE.-1) RETURN
  253. C 
  254. C         READ THE ABSTRACT AND PRINT IT. 
  255. C 
  256.           CALL NDATAIN(DIR,1,SECTION,IRECS(DIR),IERR) 
  257.           IF (IERR.NE.-1) CALL ERROR("DATAIN",IERR) 
  258. C 
  259.           CALL NEWPAGE
  260. C 
  261.           CALL PRSECT 
  262.           RETURN
  263.           END 
  264. * /---   BLOCK      OUTLIN     00 000   80/09/15  16.50 
  265.           SUBROUTINE OUTLIN 
  266. **        OUTLIN
  267. * 
  268. *         PRINT THE DOCUMENT OUTLINE.  PRINTS THE OUTLINE 
  269. *         FOR SELECTED SUBSECTIONS ONLY.  A SPACE IS PRINTED
  270. *         BEFORE EACH NEW MAJOR SECTION (DEFAULT).
  271. * 
  272. C 
  273. *CALL,DOCPRTC 
  274. C 
  275.           INTEGER CURSECT(3)
  276. C 
  277. C         TURN OFF PAGE NUMBERING AND TITLES. 
  278. C 
  279.           IPGNO = 0 
  280.           LENTTL = 0
  281.           SCTIND = 1
  282. C 
  283. C         FIRST PRINT THE PAGE HEADING. 
  284. C 
  285.           CALL NEWPAGE
  286.           CALL PRLINE(1H ,1)
  287.           PRINT 2000
  288.  2000     FORMAT ("+",31X,"'TABLE OF 'CONTENTS")
  289.           CALL PRLINE(1H ,1)
  290. C 
  291. C         LOOP THRU EACH SECTION, PRINTING IT IF SELECTED.
  292. C 
  293.           CALL SETBLNK(DIR,IERR)
  294.           IF (IERR.NE.-1) CALL ERROR("SETBLNK",IERR)
  295.           LASTONE = 0 
  296. C 
  297.   100     CONTINUE
  298.           CALL NXTSCT(CURSECT,INDEX)
  299.           IF (INDEX .EQ. -1) GOTO 500 
  300. C-- PRINT THE CURRENTLY SELECTED SECTION. 
  301.           IF (INDEX.EQ.LASTONE) GOTO 1001 
  302.           CALL BLANKLN(1) 
  303.           LASTONE = INDEX 
  304.  1001     CONTINUE
  305.           IF (PRTEXT) CALL PRINTTL(PAGENO(SCTIND))
  306.           IF (.NOT. PRTEXT) CALL PRINTTL(0) 
  307.           SCTIND = SCTIND + 1 
  308. C 
  309.           GOTO 100
  310. C 
  311.   500     CONTINUE
  312.           RETURN
  313.           END 
  314. * /---   BLOCK      PTEXT      00 000   80/09/15  16.50 
  315.           SUBROUTINE PTEXT
  316. **        PTEXT 
  317. * 
  318. *         PRINT THE TEXT OF A DOCUMENT.  PRINTS ONLY THOSE
  319. *         SUBSECTIONS WHICH ARE SELECTED. 
  320. * 
  321. * 
  322. C 
  323. *CALL,DOCPRTC 
  324. C 
  325.           INTEGER CURSECT(3)
  326. C 
  327. C 
  328. C         START PRINTING TEXT ON A NEW PAGE.
  329. C         ALSO TURN ON PAGE NUMBERS.
  330. C 
  331.           CALL NEWPAGE
  332.           IPGNO=1 
  333.           SCTIND = 1
  334. C 
  335. C         LOOP THRU EACH SECTION, PRINTING IT IF SELECTED.
  336. C 
  337.           CALL SETBLNK(DIR,IERR)
  338.           IF (IERR.NE.-1) CALL ERROR("SETBLNK",IERR)
  339. C 
  340.   100     CONTINUE
  341.           CALL NXTSCT(CURSECT,INDEX)
  342.           IF (INDEX .EQ. -1) GOTO 500 
  343. C-- PRINT THE CURRENTLY SELECTED SECTION. 
  344.           IF (INDEX.EQ.LASTONE) GOTO 1001 
  345.           CALL NEWPAGE
  346.           LASTONE = INDEX 
  347.  1001     CONTINUE
  348.           CALL PRLINE(1H ,1)
  349.           CALL PRINTTL(0) 
  350.           PAGENO(SCTIND) = IPGNO - 1
  351.           SCTIND = SCTIND + 1 
  352.           CALL PRLINE(1H ,1)
  353. C-- READ IN THE SECTION.
  354.           CALL NDATAIN(DIR,1,SECTION,IRECS(DIR),IERR) 
  355.           IF (IERR.NE.-1) CALL ERROR("DATAIN",IERR) 
  356. C-- PRINT THE SECTION.
  357.           CALL PRSECT 
  358. C 
  359.           GOTO 100
  360. C 
  361.   500     CONTINUE
  362.           RETURN
  363.           END 
  364. * 
  365.           SUBROUTINE PRSECT 
  366. **        PRSECT
  367. * 
  368. *         PRINT THE CURRENTLY READ IN SECTION.
  369. * 
  370. *CALL,DOCPRTC 
  371. C 
  372.           CALL PBUFFER(SECTION(6),(SECTION(1).AND.777B))
  373.           RETURN
  374.           END 
  375. * 
  376. * /---   BLOCK      PBUFFER    00 000   80/09/09  16.15 
  377.           SUBROUTINE NXTSCT(SCTNUM, MSNUM)
  378. * 
  379. **        NXTSCT
  380. * 
  381. *         GET THE NEXT SECTION TO BE PRINTED.  USES THE 
  382. *         SETNEXT ROUTINE TO STEP THROUGH THE FILE UNTIL A
  383. *         SELECTED SECTION IS FOUND.
  384. * 
  385. *         EXIT -
  386. * 
  387. *                SCTNUM = THE SECTION NUMBER (3 WORDS). 
  388. *                MSNUM = MAJOR SECTION OF SCTNUM.  -1 IF END
  389. *                        OF FILE. 
  390. * 
  391. * 
  392. *CALL     DOCPRTC 
  393.           LOGICAL SECTBIT 
  394.           INTEGER SCTNUM(3) 
  395. C 
  396.   100     CONTINUE
  397.           MSNUM = -1
  398. C 
  399. C         SET NEXT SECTION.  IF END OF FILE, EXIT LOOP. 
  400. C 
  401.           CALL SETNEXT(DIR,IERR)
  402.           IF (IERR.NE.-1) RETURN
  403. C 
  404. C         GET SECTION NAME AND CHECK FOR ; NAME.
  405. C 
  406.           CALL GETNAME(DIR,SCTNUM)
  407.           IF ( (SHIFT(SCTNUM,6).AND.77B) .EQ.1R; ) RETURN 
  408. C 
  409. C         GET MAJOR SECTION NUMBER. 
  410. C 
  411.           DIGIT10 = SHIFT(SCTNUM,6).AND.77B 
  412.           IF (DIGIT10.NE.0) DIGIT10=DIGIT10-1R0 
  413.           DIGIT1  = (SHIFT(SCTNUM,12).AND.77B)-1R0
  414.           MSNUM   = 10*DIGIT10 + DIGIT1 
  415. C 
  416. C         CHECK IF THIS SECTION PRINTABLE.
  417. C 
  418.           IF (.NOT.SECTBIT(MSNUM)) GOTO 100 
  419. C 
  420.           RETURN
  421.           END 
  422. * /---   BLOCK      PBUFFER    00 000   80/09/09  16.15 
  423.           SUBROUTINE PBUFFER(IBUF,LENGTH) 
  424. **        PBUFFER 
  425. * 
  426. *         PRINT A BUFFER OF TEXT.  PRINTS THE TEXT, 
  427. *         PROCESSING */, *LIST, ETC. CONTROLS.
  428. * 
  429. * 
  430. * 
  431.           INTEGER IBUF(508) 
  432. C         PROCESS EACH LINE, ONE BY ONE, UNTIL END OF TEXT. 
  433. C 
  434. C         INDEX IS THE CURRENT TEXT POINTER.
  435. C         LLEN IS THE LENGTH OF THE CURRENT LINE. 
  436. C 
  437.           ISTATUS=0 
  438.           INDEX=1 
  439. C 
  440.           IF (LENGTH.EQ.0) RETURN 
  441. C 
  442. C         FORCE END OF LINE AT END OF BUFFER. 
  443. C 
  444.           IBUF(LENGTH+1)=0
  445. C 
  446.  100      CONTINUE
  447.           CALL NEXTLIN(IBUF,INDEX,LLEN) 
  448. C 
  449. C         CHECK FOR */, ETC CONTROLS. 
  450. C 
  451.           IF (((IBUF(INDEX).AND.MASK(6)).EQ.1L*)
  452.      1                        .OR.(ISTATUS.EQ.1)) 
  453.      1           CALL FORMAT(IBUF(INDEX),LLEN,ISTATUS)
  454. C 
  455. C 
  456. C         PRINT THE CURRENT LINE OF TEXT UNLESS VALID */
  457. C         LINE FOUND. 
  458. C 
  459.           IF (ISTATUS.EQ.0) 
  460.      1          CALL PRLINE(IBUF(INDEX),LLEN) 
  461.           IF (ISTATUS.EQ.-1) ISTATUS=0
  462. C 
  463. C         UPDATE TEXT POINTER AND CHECK FOR END OF TEXT.
  464. C 
  465.           INDEX=INDEX+LLEN
  466.           IF (INDEX.LE.LENGTH) GOTO 100 
  467.           RETURN
  468.           END 
  469. * /---   BLOCK      PRBUF-UTIL 00 000   80/08/27  16.25 
  470.           SUBROUTINE NEXTLIN(IBUF,IPTR,LLEN)
  471. **        NEXTLIN(IBUF,IPTR,LLEN) 
  472. * 
  473. *         FIND THE LENGTH OF THE CURRENT LINE.
  474. * 
  475. *         IBUF IS THE TEXT BUFFER.
  476. *         IPTR IS THE CURRENT POINTER INTO THE TEXT.
  477. *         LLEN RETURNS THE LENGTH OF THE NEXT LINE. 
  478. * 
  479. *         IT IS ASSUMED THAT AN END OF LINE EXISTS. 
  480. * 
  481.           INTEGER IBUF(507) 
  482.           LOGICAL EOL 
  483. C 
  484. C         SCAN THE TEXT WORD BY WORD UNTIL AN END OF LINE 
  485. C         IS FOUND. 
  486. C 
  487.           INDEX=IPTR-1
  488. C-- LOOP
  489.  100      CONTINUE
  490.           INDEX=INDEX+1 
  491.           IF (.NOT.EOL(IBUF(INDEX))) GOTO 100 
  492. C-- ENDLOOP 
  493.           LLEN=INDEX-IPTR+1 
  494.           RETURN
  495.           END 
  496. * 
  497.           LOGICAL FUNCTION EOL(IWORD) 
  498. **        LOGICAL EOL(IWORD)
  499. * 
  500. *         FUNCTION.  RETURNS TRUE IF IWORD IS AN END OF 
  501. *         LINE (LOWER 12 BITS ZERO), ELSE FALSE.
  502. * 
  503.           EOL=((IWORD .AND. 7777B) .EQ. 0)
  504.           RETURN
  505.           END 
  506. * 
  507.           SUBROUTINE ERROR(ITYPE,IERR)
  508. **        ERROR(ITYPE,IERR) 
  509. * 
  510. *         REPORT AN ERROR IN THE PRINT.  PRINTS THE ERROR 
  511. *         TYPE AND NUMBER.  ERROR TYPE IS AN A10 CONSTANT,
  512. *         ERROR NUMBER IS THE ERROR RETURNED FROM VARIOUS 
  513. *         SUBROUTINES.
  514. * 
  515.           EXTERNAL RWORDS,NDATOUT 
  516.           PRINT *,"ERROR ",ITYPE,", NUMBER ",IERR 
  517.           CALL STRACE 
  518.           STOP
  519.           END 
  520. * 
  521.           SUBROUTINE FWORD(BUF,LEN,POS,WORD)
  522. **        FWORD(BUF,LEN,POS,WORD) 
  523. * 
  524. *         GET THE FIRST WORD FROM THE BUFFER BUF, OF LENGTH 
  525. *         LEN, RETURNING THE POSITION+1 OF THE END OF THE 
  526. *         WORD IN POS AND THE WORD IN WORD.  BUF IS IN
  527. *         R1 FORMAT.  LEADING SPACES ARE DROPPED. 
  528. * 
  529. * 
  530. * 
  531.           INTEGER BUF(LEN),POS,WORD 
  532. C 
  533.           IWORD=0 
  534. C 
  535. C-- SKIP SPACES.
  536.           DO 100 POS=1,LEN
  537.           IF (BUF(POS).NE.1R ) GOTO 150 
  538.           IF (BUF(POS).EQ.0) RETURN 
  539.   100     CONTINUE
  540.           RETURN
  541. C 
  542. C-- FIND A SPACE OR ZERO AT THE END OF THE LINE (TO ISOLATE 
  543. C-- THE WORD).
  544.   150     CONTINUE
  545.           IWSTRT=POS
  546.           DO 200 POS=IWSTRT,LEN 
  547.           IF (BUF(POS).EQ.1R ) GOTO 250 
  548.           IF (BUF(POS).EQ.0)   GOTO 250 
  549.   200     CONTINUE
  550.           RETURN
  551. C 
  552. C-- FOUND SPACE ALSO.  ENCODE THE WORD. 
  553.   250     CONTINUE
  554.           ITPOS  =POS-1 
  555.           ENCODE (10,1000,WORD) (BUF(I),I=IWSTRT,ITPOS) 
  556.  1000     FORMAT (10R1) 
  557.           RETURN
  558.           END 
  559. * /---   BLOCK      FORMAT     00 000   80/09/15  17.17 
  560.           SUBROUTINE FORMAT(LINE,LLEN,ISTATUS)
  561. **        FORMAT(LINE,LLEN,RSTATUS) 
  562. * 
  563. *         ENTRY - 
  564. * 
  565. *         LINE - ARRAY HOLDING THE CURRENT LINE.  A10 
  566. *                FORMAT.
  567. *         LLEN - LENGTH OF -LINE- IN WORDS. 
  568. * 
  569. *         EXIT -
  570. * 
  571. *         ISTATUS - RETURN STATUS.
  572. *                -1 = VALID */ LINE FOUND.
  573. *                 0 = ILLEGAL */ LINE FOUND.
  574. *                 1 = SEND THE NEXT LINE TO THIS ROUTINE. 
  575. *                     USED FOR */GRAPHU.
  576. * 
  577. *         PROCESS */, *LIST, *TYPE, AND *FORMAT WORDS.
  578. *         THE CONTROLS PROCESSED ARE BASICALLY THE SAME AS
  579. *         LESSON -PRINT- FOR LOCAL PRINTERS - 
  580. * 
  581. *         */, *LIST, *TYPE, AND *FORMAT ARE SYNONYMOUS. 
  582. * 
  583. *         THE DIRECTIVES PROCESSED ARE -
  584. * 
  585. *         */EJECT 
  586. *         */GRAPHU (IGNORED)
  587. * 
  588. * 
  589.           INTEGER LINE(LLEN),FBUF(150)
  590. C 
  591. C         IF ISTATUS=1, SKIPPING */GRAPHU FOR */END.
  592. C 
  593.           IF (ISTATUS.NE.1) GOTO 100
  594.           IF (LINE(1).EQ.5L*/END) ISTATUS=-1
  595.           RETURN
  596. C 
  597. C         EXPAND THE LINE OUT (VIA DECODE), CHECK FOR VALID 
  598. C         */ TYPE, AND GET THE FIRST */ WORD. 
  599. C 
  600.   100     CONTINUE
  601.           LCHAR=LLEN*10 
  602.           DECODE (LCHAR,2000,LINE) LCHAR,(FBUF(I),I=1,LCHAR)
  603.  2000     FORMAT (=(R1))
  604. C 
  605. C-- INITIALIZE TO BAD */ TYPE.
  606.           ISTATUS=0 
  607.           IF (FBUF(1).NE.1R*) RETURN
  608. C 
  609. C-- */ HAS NO SPACE BEFORE DIRECTIVE, ENCODE DIRECTLY.
  610.           IPOS=3
  611.           IF (FBUF(2).EQ.1R/) GOTO 200
  612. C-- SPACE AFTER * MEANS INVALID.
  613.           IF (FBUF(2).EQ.1R ) RETURN
  614. C 
  615. C-- FIND THE FIRST WORD.
  616.           CALL FWORD(FBUF(2),LCHAR-1,IPOS,IWORD)
  617.           IPOS=IPOS+1 
  618. C 
  619.           IF (IWORD.EQ.0) RETURN
  620.           IF (IWORD.EQ."LIST") GOTO 200 
  621.           IF (IWORD.EQ."TYPE") GOTO 200 
  622.           IF (IWORD.EQ."FORMAT") GOTO 200 
  623.           RETURN
  624. C 
  625. C-- HAVE A LIST COMMAND.  GET NEXT WORD FROM IT.
  626.   200     CONTINUE
  627.           CALL FWORD(FBUF(IPOS),LCHAR-IPOS+1,IPOS2,IWORD) 
  628.           IPOS=IPOS+IPOS2 
  629.           IF (IWORD.NE."EJECT") GOTO 300
  630.           CALL NEWPAGE
  631.           ISTATUS=-1
  632.           RETURN
  633. * 
  634.   300     CONTINUE
  635.           IF (IWORD.EQ."GRAPHU") ISTATUS=1
  636. C 
  637.           RETURN
  638.           END 
  639. * /---   BLOCK      PRINTTL    00 000   80/07/31  17.40 
  640.           SUBROUTINE PRINTTL(IPAGE) 
  641. **        PRINTTL 
  642. * 
  643. *         PRINT THE TITLE LINE OF THE CURRENT SUBSECTION. 
  644. * 
  645. C 
  646. *CALL,DOCPRTC 
  647. C 
  648.           INTEGER CSECT(3),DSECT(3),TITLE(5),LINE(14) 
  649. C 
  650. C 
  651.           DO 50 I = 1,14
  652.    50     LINE(I) = 0 
  653. C 
  654. C         FIRST GET THE SECTION NAME AND TITLE.  BE SURE THE
  655. C         TITLE HAS AN EOL AT THE END (EXTRA ZERO WORD).
  656. C 
  657.           CALL GETNAME(DIR,CSECT) 
  658.           CALL SECTDSP(CSECT,DSECT,SLEN)
  659.           CALL GETTTL(TITLE)
  660.           TITLE(5) = 0
  661. C 
  662. C         GET ALPHA PAGE NUMBER.
  663. C 
  664.           ENCODE (10,2000,IPG) IPAGE
  665.  2000     FORMAT (I4) 
  666.           IPG = IPG .AND. MASK(24)
  667. C 
  668. C         PACK THE FINAL LINE TOGETHER, DEPENDING ON WHETHER
  669. C         WE INCLUDE PAGE NUMBER OR NOT.
  670. C 
  671.           IF (IPAGE .EQ. 0) 
  672.      1      CALL CONCAT(LINE, LLEN, DSECT, 4L    , TITLE) 
  673.           IF (IPAGE .NE. 0) 
  674.      1      CALL CONCAT(LINE, LLEN, DSECT, 4L    , TITLE, 
  675.      2                        60, IPG)
  676. C 
  677. C 
  678.           CALL PRLINE(LINE,LLEN)
  679.           RETURN
  680.           END 
  681. * /---   BLOCK      DOCFUNC    00 000   84/03/03  18.01 
  682.           SUBROUTINE GETTTL(TITLE)
  683. **        GETTTL(TITLE) 
  684. * 
  685. *         RETURNS THE TITLE OF THE CURRENTLY SET SECTION
  686. *         IN THE VARIABLE *TITLE*.
  687. * 
  688. *CALL,DOCPRTC 
  689.           INTEGER TITLE(4),SECT(3),NAME(3)
  690. C 
  691. C         GET THE SECTION NAME. 
  692. C 
  693.           CALL GETNAME(DIR,SECT,INFO) 
  694. C 
  695. C         FIRST CHECK IF THE CURRENT MAJOR SECTION TITLES 
  696. C         ARE LOADED.  IF NOT, LOAD NEW TITLES. 
  697. C 
  698.           IF (MS.EQ.MSNUM(SECT)) GOTO 100 
  699.           MS=MSNUM(SECT)
  700.           NAME(1)=8L;TITLES. .OR. MS
  701.           NAME(2)=0 
  702.           NAME(3)=0 
  703.           CALL SETNAME(DIR,NAME,IERR) 
  704.           IF (IERR.NE.-1) CALL ERROR("T SETNAME",IERR)
  705.           CALL NDATAIN(DIR,1,TTL,IRECS(DIR),IERR) 
  706.           IF (IERR.NE.-1) CALL ERROR("DATAIN",IERR) 
  707. C 
  708.           CALL SETNAME(DIR,SECT,IERR) 
  709.           IF (IERR.NE.-1) CALL ERROR("S SETNAME",IERR)
  710.   100     CONTINUE
  711. C 
  712. C         NOW GET THE TITLE FROM THE TITLE ARRAY READ IN. 
  713. C 
  714.           IPNT=4*ITPNT(INFO)-3
  715.           IF (INDENT(INFO).EQ.0) IPNT=5 
  716.           TITLE(1)=TTL(IPNT)
  717.           TITLE(2)=TTL(IPNT+1)
  718.           TITLE(3)=TTL(IPNT+2)
  719.           TITLE(4)=TTL(IPNT+3)
  720.           RETURN
  721.           END 
  722. * 
  723.           INTEGER FUNCTION MSNUM(ISECT) 
  724. **        MSNUM(ISECT)
  725. * 
  726. *         RETURN THE MAJOR SECTION NUMBER OF SECTION
  727. *         -ISECT-.  MAJOR SECTION NUMBER IS RETURNED IN THE 
  728. *         STANDARD DOCUMENTOR DISPLAY CODE FORMAT FOR 
  729. *         SECTION NUMBERS.
  730. * 
  731.           MSNUM=SHIFT(ISECT,12).AND.7777B 
  732.           RETURN
  733.           END 
  734. * 
  735.           INTEGER FUNCTION ITPNT(INFO)
  736. **        ITPNT(INFO) 
  737. * 
  738. *         RETURNS THE TITLE POINTER OF THE SECTION WITH 
  739. *         ZINFO *INFO*. 
  740. * 
  741.           ITPNT=SHIFT(INFO,-4).AND.377B 
  742.           RETURN
  743.           END 
  744. * 
  745.           INTEGER FUNCTION INDENT(INFO) 
  746. **        INDENT(INFO)
  747. * 
  748. *         RETURNS THE INDENT LEVEL OF THE SECTION WITH ZINFO
  749. *         *INFO*. 
  750. * 
  751.           INDENT=INFO.AND.17B 
  752.           RETURN
  753.           END 
  754. * 
  755. * /---   BLOCK      DOCFUNC    00 000   80/07/31  20.07 
  756.           SUBROUTINE SECTDSP(SECT,DSECT,NCHR) 
  757. **        SECTDSP(SECT,DSECT,NCHR)
  758. * 
  759. *         ENTRY - SECT IS THE CURRENT SECTION NUMBER IN 
  760. *                DOCUMENTOR FORMAT (NAMESET NAME FORM). 
  761. * 
  762. *         EXIT - DSECT IS THE SECTION NUMBER IN DISPLAY 
  763. *                FORMAT.  NCHR IS THE NUMBER OF CHARACTERS
  764. *                IN THE PACKED SECTION NUMBER.
  765. * 
  766. C 
  767.           INTEGER SECT(3),DSECT(3),TEMP(26) 
  768. C 
  769. C         CONVERT SECT TO R FORMAT DISPLAY CODE.
  770. C 
  771.           DECODE (26,2000,SECT) (TEMP(I),I=1,26)
  772.  2000     FORMAT (26R1) 
  773. C 
  774. C         LOOP THRU, REMOVING 0 CHARACTERS AND PACKING THE
  775. C         SECTION NAME. 
  776. C 
  777.           INPTR=0 
  778.           DO 100 IOPTR=1,26 
  779.           IF (TEMP(IOPTR).EQ.0) GOTO 100
  780.           INPTR=INPTR+1 
  781.           TEMP(INPTR)=TEMP(IOPTR) 
  782.   100     CONTINUE
  783. C 
  784.           INPTR = INPTR + 1 
  785.           DO 200 IOPTR = INPTR,26 
  786.   200     TEMP(IOPTR) = 0 
  787. C 
  788. C         REPACK THE NEW SECTION NUMBER AND RETURN. 
  789. C 
  790.           NCHR=INPTR-1
  791.           ENCODE (26,2000,DSECT) (TEMP(I),I=1,26) 
  792. C 
  793. C         ZERO THE BOTTOM 4 CHARACTERS OF DSECT.
  794. C 
  795.           DSECT(3) = DSECT(3) .AND. MASK(36)
  796.           RETURN
  797.           END 
  798. * 
  799.           LOGICAL FUNCTION SECTBIT(INDEX) 
  800. **        SECTBIT(INDEX)
  801. * 
  802. *         RETURNS THE VALUE OF SELECTION BIT -INDEX- (ON
  803. *         OR OFF).
  804. * 
  805. * 
  806. C 
  807. *CALL,DOCPRTC 
  808. C 
  809.           IWORD=(INDEX+59)/60 
  810.           IBIT =MOD(INDEX-1,60)+1 
  811.           SECTBIT = (SHIFT(SECBITS(IWORD),IBIT).AND.1) .EQ. 1 
  812.           RETURN
  813.           END 
  814. * /---   BLOCK      PR LINES   00 000   80/08/27  16.20 
  815.           SUBROUTINE PINIT
  816. **        PINIT 
  817. * 
  818. *         INITIALIZE PRINT PARAMETERS.
  819. * 
  820. * 
  821. C 
  822. C         COMMON FOR PRINT PARAMETERS.
  823. C 
  824. *CALL,DOCPRTC 
  825. C 
  826. C         INITIALIZE STUFF. 
  827. C         LINNO SET LARGE TO SIMULATE END OF PAGE.
  828. C 
  829.           LENTTL=0
  830.           ISPACE=1
  831.           IPGNO=0 
  832.           LINNO=1000
  833. C 
  834.           DO 100 I=1,15 
  835.           PTITLE(I)=0 
  836.   100     CONTINUE
  837.           RETURN
  838. C 
  839.           END 
  840. * 
  841.           SUBROUTINE NEWPAGE
  842. **        NEWPAGE 
  843. * 
  844. *         ADVANCE TO A NEW PAGE.
  845. * 
  846. * 
  847. * 
  848. *CALL,DOCPRTC 
  849. C 
  850.           LINNO=1000
  851.           RETURN
  852.           END 
  853. * 
  854.           SUBROUTINE PRLINE(LINE,LLEN)
  855. **        PRLINE(LINE,LEN)
  856. * 
  857. *         PRINT A LINE OF THE MODULE.  KEEPS TRACK OF 
  858. *         POSITION ON THE PAGE AND CURRENT SPACING BETWEEN
  859. *         LINES.
  860. * 
  861. C 
  862. C         COMMON FOR PRINT PARAMETERS.
  863. C 
  864. *CALL,DOCPRTC 
  865. C 
  866.           INTEGER LINE(LLEN)
  867. C 
  868. C         CHECK FOR END OF PAGE.
  869. C         IF AT END OF PAGE, PRINT THE TITLE + NEW PAGE ^$. 
  870. C 
  871.           IF (LINNO.LE.56) GOTO 100 
  872. C 
  873.           PRINT 2000
  874.           IF (IPGNO.EQ.0) GOTO 50 
  875.           PRINT 2001,IPGNO
  876.           IPGNO=IPGNO+1 
  877.    50     CONTINUE
  878.           LINNO=0 
  879.           IF (LENTTL.NE.0)
  880.      1      PRINT 2002,LENTTL,(PTITLE(I),I=1,LENTTL)
  881.           PRINT 2003
  882.  2000     FORMAT (1H1)
  883.  2001     FORMAT (50X,"PAGE ",I4) 
  884.  2002     FORMAT (19X,=(A10)//) 
  885.  2003     FORMAT (//) 
  886.   100     CONTINUE
  887. C 
  888. C         PRINT THE LINE
  889. C 
  890.           ISP=1 
  891.   200     CONTINUE
  892.           IF (ISP.GE.ISPACE) GOTO 300 
  893.           PRINT 2004
  894.  2004     FORMAT (1X) 
  895.           ISP=ISP+1 
  896.           GOTO 200
  897.   300     CONTINUE
  898. C 
  899. C         CLEAN THE LINE TO AVOID TRAILING COLONS FROM NOS. 
  900. C 
  901.           CALL CLEAN(LINE,LLEN) 
  902. C 
  903.           PRINT 2005,LLEN,(LINE(I),I=1,LLEN)
  904.  2005     FORMAT (9X,=(A10))
  905. C 
  906.           LINNO=LINNO+ISPACE
  907. C 
  908.           RETURN
  909.           END 
  910. * 
  911.           SUBROUTINE BLANKLN(NUMCR) 
  912. **        BLANKLN(NUMCR)
  913. * 
  914. *         PRINT *NUMCR* BLANK LINES.
  915. * 
  916.           DO 100 I=1,NUMCR
  917.           CALL PRLINE(" ",1)
  918.   100     CONTINUE
  919.           RETURN
  920.           END 
  921. * 
  922. * /---   BLOCK      UTIL       00 000   80/07/29  15.01 
  923.           SUBROUTINE CLEAN(ISTR,LEN)
  924. **        CLEAN(ISTR,LEN) 
  925. * 
  926. *         CONVERTS ZERO CODES (00B) TO SPACES WITHIN A
  927. *         CHARACTER STRING. 
  928. * 
  929.           INTEGER ISTR(LEN) 
  930. C 
  931. C         LOOP THRU EACH WORD IN THE STRING.
  932. C 
  933.           DO 200 I=1,LEN
  934.           IWORD=ISTR(I) 
  935. C 
  936. C         LOOP THRU EACH CHARACTER.  IF THE CHARACTER IS A
  937. C         ZERO CODE, REPLACE IT WITH A SPACE. 
  938. C 
  939.           DO 100 J=1,10 
  940.           IF ((IWORD.AND.77B).EQ.0) IWORD=IWORD.OR.1R 
  941.           IWORD=SHIFT(IWORD,6)
  942.   100     CONTINUE
  943. C 
  944.           ISTR(I)=IWORD 
  945.   200     CONTINUE
  946. C 
  947.           RETURN
  948.           END 
  949.           INTEGER FUNCTION CNTCHR(ICHR,ISTR,LEN)
  950. **        CNTCHR(ICHR,ISTR,LEN) 
  951. * 
  952. *         COUNT THE NUMBER OF OCCURRENCES OF CHARACTER ICHR 
  953. *         IN THE STRING ISTR. 
  954. * 
  955.           INTEGER ISTR(LEN) 
  956. C 
  957. C         LOOP THRU EACH WORD IN THE STRING.
  958. C 
  959.           CNTCHR = 0
  960.           DO 200 I=1,LEN
  961.           IWORD=ISTR(I) 
  962. C 
  963. C         LOOP THRU EACH CHARACTER.  IF THE CHARACTER IS A
  964. C         ZERO CODE, REPLACE IT WITH A SPACE. 
  965. C 
  966.           DO 100 J=1,10 
  967.           IF ((IWORD.AND.77B).EQ.ICHR) CNTCHR = CNTCHR + 1
  968.           IWORD=SHIFT(IWORD,6)
  969.   100     CONTINUE
  970. C 
  971.   200     CONTINUE
  972. C 
  973.           RETURN
  974.           END 
  975. * /---   BLOCK      CONCAT     00 000   84/03/04  17.27 
  976.           IDENT  CONCAT 
  977.           ENTRY  CONCAT 
  978.           TITLE  CONCAT  - CONCATENATE STRING 
  979.           BASE   DECIMAL
  980.  
  981. ***       CONCAT - CONCATENATE STRINGS (FORTRAN CALLABLE) 
  982. *         S. BIRTH  FEBRUARY 1982.
  983. * 
  984. *         FROM FORTRAN -
  985. * 
  986. *  CALL CONCAT(OUTSTRING,OUTWORDS,IN1,IN2, ... ,INI)
  987. * 
  988. *         WHERE *IN1 - INI* IS ANY NUMBER OF STRINGS
  989. *         EACH TERMINATED BY AN END OF LINE.   OUTSTRING
  990. *         SHOULD BE AS LARGE AS THE SUM OF ALL THE INPUT
  991. *         STRINGS.
  992. * 
  993. *         THE NUMBER OF WORDS IN OUTSTRING IS RETURNED, 
  994. *         INCLUDING AN END OF LINE. 
  995. * 
  996. *         NOTE THAT IT IS LEGAL FOR THE SAME STRING TO
  997. *         APPEAR MORE THAN ONCE AS INPUT.  IT IS ALSO 
  998. *         LEGAL FOR THE SAME STRING TO APPEAR AS *OUTSTRING*
  999. *         AND AS *IN1,* THE FIRST INPUT STRING.  SO THE 
  1000. *         FOLLOWING IS LEGAL -
  1001. * 
  1002. *       PERIOD = L"." 
  1003. *       STRING(1) = 3LCAT 
  1004. *       CALL CONCAT(STRING,WORDS,STRING,PERIOD,PERIOD)
  1005. * 
  1006. *         IT IS NOT LEGAL, HOWEVER, TO HAVE THE OUTPUT
  1007. *         STRING APPEAR IN THE LIST OF INPUTS IN ANY OTHER
  1008. *         POSITION; IT IS NOT POSSIBLE TO CONCATENATE A 
  1009. *         PREFIX ONTO A STRING. 
  1010. * 
  1011. * 
  1012. *         REGISTER USE IN THIS ROUTINE IS;
  1013. * 
  1014. *         A1 = ADDRESS OF PARAMETER LIST. 
  1015. *         A2 = ADDRESS OF CURRENT PARAMETER IN PARM LIST. 
  1016. *         A3 = ADDRESS OF CURRENT INPUT WORD. 
  1017. *         A6 = ADDRESS TO WRITE INTO (WORK REGISTER). 
  1018. * 
  1019. *         X0 = 7777B (END OF LINE MASK) 
  1020. *         X1 = ADDRESS OF OUTPUT STRING (START OF IT).
  1021. *         X2 = ADDRESS OF START OF CURRENT PARM STRING. 
  1022. *         X3 = CURRENT WORD OF PARM STRING. 
  1023. *         X4 = LMASK(6) (CHARACTER MASK). 
  1024. *         X6 = OUTPUT WORD BEING PACKED UP. 
  1025. *         X7 = WORK REGISTER (ESCAPE CHARACTER CHECK).
  1026. * 
  1027. *         B1 = 1
  1028. *         B3 = CHARACTERS REMAINING IN X3 
  1029. *         B4 = CURRENT COLUMN 
  1030. *         B5 = MISC CONSTANTS (10, 30)
  1031. *         B6 = CHARACTERS IN OUTPUT (X6)
  1032. *         B7 = WORDS WRITTEN TO OUTPUT STRING.
  1033. * 
  1034.  MAXWORDS =      30          MAXIMUM OUTPUT STRING WORDS
  1035.  CPW      =      10          CHARACTERS PER WORD
  1036.  
  1037. * /---   BLOCK      CONCAT     00 000   84/03/04  17.27 
  1038.  TRACEW   SET    *
  1039.           VFD    42/0HCONCAT,18/CONCAT
  1040.  CONCAT   CON    0
  1041.           SB1    1           CONSTANTS
  1042.           SX0    7777B       EOL MASK 
  1043.           MX4    6           CHARACTER MASK 
  1044.           SB2    B0          EXTRA SPACES NEEDED
  1045.  
  1046. *         INITIALIZATION
  1047. *                            A1/X1 = FWA OF PARAM LIST
  1048.           SA2    A1+1        A2/X2 = CURRENT WORD IN LIST 
  1049.           SB4    B0          B4 = COLUMN COUNT
  1050.           MX6    0           X6 = OUTPUT REGISTER 
  1051.           SB6    B0          B6 = CHARS IN X6 
  1052.           SB7    B0          B7 = WORDS WRITTEN TO OUTSTRING
  1053.  
  1054. *         LOOP ON INPUT STRINGS 
  1055.  CON2     SA2    A2+B1       GET NEXT PARAMETER 
  1056.           ZR     X2,CON10    IF END OF LIST 
  1057.           SA3    X2          A3/X3 = CURRENT INPUT WORD 
  1058.           BX5    -X0*X3      CHECK FOR TAB FUNCTION 
  1059.           ZR     X5,CON3     BRANCH IF TAB FUNCTION 
  1060.           SB3    CPW         B3 = CHARACTERS IN X3
  1061.           SB2    B0          B2 = 0 SPACES
  1062.           EQ     CON5 
  1063.  
  1064. *         TAB FUNCTION, SET VARS TO ADD SPACES. 
  1065.  CON3     SB3    0           B3 = CHARS IN X3 = 0 
  1066.           SB2    X3          B2 = TAB STOP TO REACH.
  1067.           SX3    0           NEEDED TO TERMINATE LOOP OK. 
  1068.           SB2    B2-B4       B2 = CHARS TO GO FOR COLUMN. 
  1069.           LE     B2,B0,CON2  SKIP IF ALREADY THERE. 
  1070.  
  1071. *         LOOP ON INPUT CHARACTERS TRANSFERRED
  1072.  CON4     SX5    55B
  1073.           LX5    54          CREATE LEFT JUSTIFIED SPACE. 
  1074.           SB2    B2-B1       DECREMENT SPACE COUNT. 
  1075.           EQ     CON5A       GO STORE IT AWAY.
  1076.  
  1077.  CON5     BX5    X3*X4       NEXT CHARACTER 
  1078.           SB3    B3-B1
  1079.           LX3    6
  1080.           ZR     X5,CON8     IF ZERO CHARACTER
  1081.  
  1082. * /---   BLOCK      CONCAT     00 000   84/03/04  17.27 
  1083. *         WRITE CHAR TO OUTPUT REGISTER 
  1084.  CON5A    BX6    X5+X6       WRITE ONE CHAR TO X6 
  1085.           SB6    B6+B1
  1086.           SB4    B4+B1
  1087.           LX6    6
  1088.           SB5    CPW
  1089.           LT     B6,B5,CON6  IF X6 NOT FULL 
  1090.           SA6    X1+B7       WRITE WORD TO OUTSTRING
  1091.           SB7    B7+B1
  1092.           SB6    B0 
  1093.           MX6    0
  1094.           SB5    MAXWORDS 
  1095.           GT     B7,B5,CONERR2  IF OUTSTRING TOO LONG 
  1096.  
  1097. *         CHECK FOR ESCAPE CHARACTER (76B OR 70B) 
  1098.  CON6     LX5    6           CHAR IN BITS 5 - 0 
  1099.           SX7    70B         CHECK SHIFT CODE 
  1100.           IX7    X5-X7
  1101.           ZR     X7,CON7
  1102.           SX7    76B         CHECK ACCESS CODE
  1103.           IX7    X5-X7
  1104.           NZ     X7,CON8     IF NORMAL CHAR 
  1105.  CON7     SB4    B4-B1       ADJUST COUNT 
  1106.  
  1107. *         FIND NEXT INPUT CHARACTER 
  1108.  CON8     GT     B2,B0,CON4  IF MORE SPACES TO GET. 
  1109.           GT     B3,B0,CON5  IF X3 NOT EMPTY
  1110.           BX5    X3*X0
  1111.           ZR     X5,CON2     IF EOL ENCOUNTERED 
  1112.           SA3    A3+B1       GET NEXT WORD
  1113.           SB3    CPW
  1114.           EQ     CON5 
  1115.  
  1116. *         WRITE X6 TO OUTSTRING AND PUT EOL 
  1117.  CON10    SB5    CPW
  1118.           SX5    B5-B6       LEFT JUSTIFY X6
  1119.           SX7    6
  1120.           IX5    X5*X7       SHIFT COUNT
  1121.           SB5    X5 
  1122.           LX6    X6,B5       FIRST CHAR ON LEFT.
  1123.           SA6    X1+B7
  1124.           SB7    B7+B1
  1125.           BX5    X6*X0
  1126.           ZR     X5,CON12    IF EOL ALREADY EXISTS
  1127.           MX6    0
  1128.           SA6    X1+B7       WRITE ZERO WORD
  1129.           SB7    B7+B1
  1130.  CON12    SX6    B7          RETURN OUTSTRING WORDCOUNT 
  1131.           SA2    A1+B1       IN 2ND PARAMETER 
  1132.           SA6    X2 
  1133.           EQ     CONCAT      RETURN 
  1134.  
  1135.  CONERR2  EQ     CONCAT 
  1136.           END
plato/source/plaopl/docprt.txt · Last modified: 2023/08/05 18:54 by Site Administrator