SECHDR
          IDENT  SECHDR,FWA 
          ABS 
          SST 
          ENTRY  SECHDR 
          ENTRY  RFL= 
          ENTRY  SSJ= 
          SYSCOM B1 
          TITLE  SECHDR - WRITE SECURITY HEADERS. 
*COMMENT  SECHDR - WRITE SECURITY HEADERS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       SECHDR - WRITE SECURITY HEADERS.
* 
*         P. J. ENGLE.       82/09/01.
*         J.    HOLLISTER    83/06/21.
          SPACE  4,10 
***       *SECHDR* WRITES SECURITY BANNER AND/OR PAGE HEADING 
*         AND FOOTING INFORMATION ON THE NAMED FILE.
          SPACE  4,10 
***       COMMAND FORMAT. 
* 
*         SECHDR,LFN,FF,OP=BFRP.
* 
*         LFN = NAME OF THE FILE TO WHICH SECURITY INFORMATION
*                IS TO BE ADDED.
* 
*         FF = THE FILE IS ALREADY FORMATTED FOR OUTPUT.
* 
*         THE FOLLOWING OPTIONS ARE VALID - 
* 
*         B = PRINT A BANNER PAGE AT THE BEGINNING AND END OF 
*                EACH LOGICAL UNIT AS SPECIFIED BY THE  *F* OR *R*
*                OPTION.  IF NEITHER THE *F* NOR THE *R* OPTION IS
*                SPECIFIED, BANNER PAGES WILL BE PRINTED AT THE 
*                BEGINNING AND END OF INFORMATION OF THE FILE.  THIS
*                OPTION IS SELECTED BY DEFAULT. 
* 
*         F = USE LOGICAL FILES AS BANNER PAGE UNIT.
* 
*         R = USE LOGICAL RECORDS AS BANNER PAGE UNIT.
* 
*         P = PRINT PAGE HEADINGS AND FOOTINGS ON EACH PAGE 
*                OF OUTPUT.  THIS OPTION IS DESELECTED BY DEFAULT.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * ERROR IN SECHDR PARAMETERS.* = *SECHDR* HAS ENCOUNTERED 
*         AN UNKNOWN PARAMETER. 
* 
*         * NNNNN LINES TRUNCATED.* = INFORMATIVE MESSAGE INDICATING
*         NNNNN LINES HAD TO BE TRUNCATED WHEN FORMATTING THE FILE. 
* 
*         * NO FILE NAME SPECIFIED.* = *SECHDR* HAS FOUND THAT NO 
*         FILE NAME WAS SPECIFIED ON THE COMMAND CALL.
* 
*         * UNABLE TO PROCESS TERMINAL FILE.* = THE SPECIFIED FILE IS 
*         ASSIGNED TO A TERMINAL. 
* 
*         * UNKNOWN OPTION - X.* = *SECHDR* HAS ENCOUNTERED AN UNKNOWN
*         OPTION. 
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMSMLS 
*CALL     COMSPFM 
          SPACE  4,10 
****      ASSEMBLY CONSTANTS. 
  
  
 SSJ=     EQU    0
 FBUFL    EQU    1001B       FILE BUFFER LENGTH 
 SBUFL    EQU    1001B       SCRATCH BUFFER LENGTH
 WBUFL    EQU    140D        WORKING BUFFER LENGTH
****
          SPACE  4,10 
          TITLE  FETS AND RESERVED LOCATIONS. 
          ORG    126B 
          SPACE  4,10 
 FWA      BSS    0
  
*         FETS. 
  
  
 F        BSS    0           LOCAL FILE 
 SECFILE  FILEB  FBUF,FBUFL,FET=7 
  
 S        BSS    0           SCRATCH FILE 
 ZZZZZG1  FILEB  SBUF,SBUFL,FET=7 
          SPACE  4,10 
*         GLOBAL STORAGE. 
  
  
 ALVL     CON    0           ACCESS LEVEL NAME
 BCFL     CON    0           BACKCOPY FLAG
 BLKL     CON    1L          BLANK LINE 
 BOPL     CON    1L2         BOTTOM OF PAGE LINE
 BPBL     CON    0           LENGTH OF ACCESS LEVEL NAME BUFFER 
 BUNT     CON    1           BANNER UNIT
 EPWH     CON    0           EMPTY PAGE WITH HEADER FLAG
 FORM     CON    0           FORMATTED FILE 
 LCNT     CON    0           LINES REMAINING
 LNPG     CON    0           LINES/PAGE 
 LTCT     CON    0           LINES TRUNCATED COUNT
 PDEN     CON    0           PRINT DENSITY
 POPT     CON    0           PAGE HEAD/FOOT OPTION
  
  
*         PAGE HEADING/FOOTING. 
  
  
 FOOT     DATA   1L          PAGE FOOTING 
          DATA   40H          XXXXXXX             XXXXXXX 
          DATA   50H          XXXXXXX             XXXXXXX 
          DATA   40HXXXXXX              XXXXXXX 
          CON    0
          DATA   1L 
 FOOTL    EQU    *-FOOT      PAGE FOOTING LENGTH
  
 HEAD     DATA   1L1         PAGE HEADING 
          DATA   40H          XXXXXXX             XXXXXXX 
          DATA   50H          XXXXXXX             XXXXXXX 
          DATA   40HXXXXXX              XXXXXXX 
          CON    0
          DATA   1L 
 HEADL    EQU    *-HEAD      PAGE HEADING LENGTH
  
 SHFL     EQU    6           SECURITY HEADING/FOOTING LINE COUNT
          TITLE  MAIN PROGRAM.
          SPACE  4,10 
*         MAIN PROGRAM. 
  
  
 SECHDR   SB1    1
          RJ     PRS         PRESET 
          WRITEC S,PDEN      WRITE PRINT DENSITY CONTROL
          SA1    BUNT 
          SX1    X1-1 
          PL     X1,SEC1     IF NO BANNER PAGE TO BE WRITTEN
          RJ     CBP         CREATE BANNER PAGE 
          RJ     WBP         WRITE BANNER PAGE
          SX0    B0+         SET DATA READ
 SEC1     SA1    POPT 
          ZR     X1,SEC3     IF HEAD/FOOT OPTION NOT SET
          SA1    FORM        CHECK IF FILE FORMATTED
          ZR     X1,SEC2     IF FILE NOT FORMATTED
          RJ     HFF         HEAD/FOOT PROCESSOR FOR FORMATTED FILE 
          EQ     SEC4        BACKCOPY FILE
  
 SEC2     RJ     HFU         HEAD/FOOT PROCESSOR FOR UNFORMATTED FILE 
          EQ     SEC4        BACKCOPY FILE
  
 SEC3     RJ     BPP         BANNER PAGE PROCESSOR
 SEC4     RJ     BCF         BACKCOPY FILE
          ENDRUN
          TITLE  SUBROUTINES. 
 BCF      SPACE  4,10 
**        BCF - BACKCOPY FILE.
* 
*         ENTRY  (BCFL) = BACKCOPY FLAG.
* 
*         USES   X - 1. 
*                A - 1. 
* 
*         MACROS READ, READW, RECALL, RENAME, RETURN, REWIND, WRITEF, 
*                WRITER, WRITEW.
  
  
 BCF      SUBR               ENTRY/EXIT 
          REWIND F
          REWIND S
          SA1    BCFL        GET BACKCOPY FLAG
          NZ     X1,BCF6     IF BACKCOPY NOT REQUIRED 
 BCF1     READ   S
          RECALL F
 BCF2     READW  S,WBUF,WBUFL 
          ZR     X1,BCF3     IF TRANSFER COMPLETE 
          NG     X1,BCF4     IF EOF OR EOI
  
*         EOR ENCOUNTERED.
  
          WRITEW F,WBUF,X1-WBUF  WRITE LAST PORTION OF RECORD 
          WRITER F
          EQ     BCF1        READ NEXT RECORD 
  
 BCF3     WRITEW F,WBUF,WBUFL 
          EQ     BCF2        TRANSFER MORE DATA 
  
 BCF4     SX1    X1+1 
          NG     X1,BCF5     IF EOI ENCOUNTERED 
  
*         EOF ENCOUNTERED.
  
          WRITEF F
          EQ     BCF1        READ NEXT RECORD 
  
*         EOI ENCOUNTERED.
  
 BCF5     RETURN S           RETURN SCRATCH FILE
          REWIND F           REWIND FILE
          EQ     BCFX        RETURN 
  
 BCF6     RENAME S,F
          EQ     BCFX        RETURN 
 BPP      SPACE  4,15 
**        BPP - BANNER PAGE PROCESSOR.
* 
*         ENTRY  (BUNT) = BANNER UNIT VALUE.
*                (X0) = 0 (DATA READ FLAG). 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
* 
*         CALLS  CLC, WBP.
* 
*         MACROS READ, READS, RECALL, WRITEC, WRITEF, WRITER, WRITES. 
* 
*         DEFINE (X0) = 0 IF DATA READ. 
*                     = -1 IF NO DATA (EOR).
*                     = -2 IF NO DATA (EOF).
  
 BPP      SUBR               ENTRY/EXIT 
  
*         READ FILE.
  
 BPP1     SX7    1R1         SET NEW PAGE FOR UNFORMATTED FILE
          SA7    WBUFS
          SA1    LNPG        FORCE NEW PAGE 
          BX6    X1 
          SA6    LCNT 
          READ   F
          RECALL S
 BPP2     READS  F,WBUF,WBUFL 
          ZR     X1,BPP3     IF TRANSFER COMPLETE 
          SA5    BUNT        GET BANNER UNIT
          SX5    X5+B1
          NG     X1,BPP6     IF EOF OR EOI
  
*         EOR ENCOUNTERED.
  
          WRITER S
          SX0    B0+         SET DATA (EOR) READ
          SX1    X5-1 
          NG     X1,BPP1     IF BANNER UNIT NOT RECORD
          RJ     WBP         WRITE BANNER PAGE
          SX0    -1          SET NO DATA (EOR)
          EQ     BPP1        READ NEXT RECORD 
  
*         WRITE FILE LINE 
  
 BPP3     SA2    FORM 
          SA1    WBUFS+X2    GET FIRST CHARACTER IN LINE
          BX0    X0-X0       SET DATA READ
          LX1    -6          LEFT JUSTIFY CHARACTER 
          RJ     CLC         CHECK LINE COUNT 
          NG     X2,BPP2     IF LINE SHOULD NOT BE WRITTEN
          NZ     X2,BPP5     IF NOT END OF PAGE 
          ZR     X4,BPP5     IF LINE ALREADY HAS PAGE EJECT 
 BPP4     WRITEC S,BOPL      SKIP TO BOTTOM OF PAGE 
 BPP5     SA1    FORM        FORMAT OUTPUT IF FILE UNFORMATTED
          SX1    X1+WBUFS 
          WRITES S,X1,WBUFL 
          SX6    1R          RESET FIRST CHARACTER BLANK
          SA6    WBUFS
          EQ     BPP2        TRANSFER MORE DATA 
  
 BPP6     SX1    X1+1 
          NG     X1,BPP9     IF EOI ENCOUNTERED 
  
*         EOF ENCOUNTERED.
  
          WRITEF S
          ZR     X5,BPP7     IF BANNER UNIT FILE
          SX1    X5-1 
          NZ     X1,BPP8     IF BANNER UNIT NOT RECORD
          SX1    X0+1 
          ZR     X1,BPP8     IF NO DATA (EOR) 
 BPP7     RJ     WBP         WRITE BANNER PAGE
 BPP8     SX0    -2          SET NO DATA (EOF)
          EQ     BPP1        READ NEXT RECORD 
  
*         EOI ENCOUNTERED.
  
 BPP9     NG     X5,BPP10    IF BANNER AT BOI/EOI 
          NG     X0,BPPX     IF NO DATA READ SINCE LAST BANNER WRITTEN
 BPP10    RJ     WBP         WRITE BANNER PAGE
          EQ     BPPX 
 CBP      SPACE  4,15 
**        CBP - CREATE BANNER PAGE. 
* 
*         EXIT   (BPBL) = LENGTH OF ACCESS LEVEL NAME BUFFER. 
* 
*         USES   X - 0, 1, 2, 4, 6. 
*                A - 1, 2, 4, 6.
*                B - 2. 
* 
*         CALLS  BAN. 
* 
*         MACROS DATE, USERNUM. 
  
  
 CBP      SUBR               ENTRY/EXIT 
          SA1    F           GET FILE NAME
          MX0    42 
          BX6    X0*X1
          SA6    BPBA+2 
          DATE   BPBB+2      GET CURRENT DATE 
          SA1    BPBB+2      REMOVE LEADING SPACE 
          SB2    6
          LX6    X1,B2
          SA6    A1 
          USERNUM  BPBC+2    GET USER NAME
          SA4    ALVL        GET ACCESS LEVEL NAME
          SA2    BPB2 
          RJ     BAN         ENCODE BANNER MESSAGE
          SX6    A2-BPB2     STORE LENGTH OF ACCESS LEVEL NAME BUFFER 
          SA6    BPBL 
          EQ     CBPX        RETURN 
 CLC      SPACE  4,15 
**        CLC - CHECK LINE COUNT. 
* 
*         ENTRY  (X1) = FIRST CHARACTER OF LINE, LEFT JUSTIFIED.
* 
*         EXIT   (X2) = 1, IF NOT END OF PAGE.
*                     = 0, IF END OF PAGE.
*                     = -1, IF LINE SHOULD NOT BE PRINTED.
*                (X7) = LINES LEFT ON PAGE. 
*                (X5) = 0, IF PAGE EMPTY BEFORE READING THIS LINE.
*                (X4) = 0, IF CHARACTER IS PAGE EJECT.
*                     = 1, IF CHARACTER IS NOT PAGE EJECT.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  RCC, SBP.
* 
*         MACROS WRITEW.
  
  
 CLC10    SX3    1           FORCE LINE INCREMENT OF ONE
 CLC11    SA4    LCNT        UPDATE LINE COUNT
          IX7    X4-X3
          SA7    A4 
          SX2    B1+         SET NOT END OF PAGE
          PL     X7,CLC13    IF NOT END OF PAGE 
 CLC12    SA2    LNPG        RESET LINE COUNT 
          IX6    X2-X3
          IX7    X7+X3       RESET LINES REMAINING ON PAGE
          SA6    LCNT 
          SX2    B0+         SET END OF PAGE
 CLC13    SX4    B1+         SET NOT PAGE EJECT 
          SA5    CLCA        SET PAGE EMPTY STATUS
  
 CLC      SUBR
          SA2    LNPG        SAVE PAGE EMPTY STATUS 
          SA3    LCNT 
          SA4    EPWH 
          IX6    X2-X3
          IX6    X4+X6       ADD *EMPTY PAGE WITH HEADER* FLAG
          SA6    CLCA 
          BX7    X7-X7       CLEAR FLAG 
          SA7    A4 
          MX6    6
          SA3    BLKL        CHECK FOR CARRIAGE CONTROL 
          BX3    X1-X3
          ZR     X3,CLC10    IF NO CARRIAGE CONTROL 
          SB2    TCCCL-1
 CLC1     SA3    TCCC+B2     SEARCH FOR CARRIAGE CONTROL CHARACTER
          BX4    X6*X3
          BX7    X4-X1
          ZR     X7,CLC2     IF CHARACTER FOUND 
          SB2    B2-1 
          PL     B2,CLC1     IF MORE TABLE TO SEARCH
          EQ     CLC10       IGNORE UNKNOWN CARRIAGE CONTROL CHARACTER
  
 CLC2     SX3    X3          EXTRACT LINE COUNT 
          SX2    -B1
          NG     X3,CLCX     IF LINE TO BE IGNORED
          SA1    LNPG        SET PAGE EMPTY STATUS
          SA2    LCNT 
          LX4    6
          SA5    CLCA 
          SX7    X4-1R2 
          ZR     X7,CLC6     IF CARRIAGE CONTROL IS *2* 
          SX7    X4-1R/ 
          ZR     X7,CLC9     IF CARRIAGE CONTROL IS */* 
          SX7    X4-1R1 
          NZ     X7,CLC11    IF CARRIAGE CONTROL IS NOT *1* 
  
*         PROCESS PAGE EJECT. 
  
 CLC3     BX7    X2          SET LINES LEFT ON PAGE 
          IX6    X1-X3       UPDATE LINE COUNT
          SA6    LCNT 
          SA1    POPT 
          ZR     X1,CLC4     IF CARRIAGE CONTROL SHOULD BE LEFT ON
          RJ     RCC         REMOVE CARRIAGE CONTROL CHARACTER
 CLC4     SX2    B0+         SET END OF PAGE
          NZ     X5,CLC5     IF PAGE NOT EMPTY
          SX2    B1          SET NOT END OF PAGE
 CLC5     BX4    X4-X4       SET PAGE EJECT 
          EQ     CLCX        RETURN 
  
*         PROCESS SKIP TO BOTTOM OF PAGE. 
  
 CLC6     SA3    POPT 
          NZ     X3,CLC7     IF CARRIAGE CONTROL SHOULD BE REMOVED
          BX7    X1          RESET LINE COUNT 
          SA7    LCNT 
          SX2    B1          SET NOT END OF PAGE
          EQ     CLC13       SET NOT PAGE EJECT 
  
 CLC7     SX7    X2-1 
          NZ     X5,CLC8     IF PAGE NOT EMPTY
          WRITEW S,HEAD,HEADL  WRITE HEADER 
          SA1    LNPG 
          SX7    X1-1 
 CLC8     RJ     SBP         SKIP TO BOTTOM OF PAGE 
          RJ     RCC         REMOVE CARRIAGE CONTROL CHARACTER
          BX7    X7-X7       SET PAGE AT LAST LINE
          SA7    LCNT 
          SX2    B1          SET NOT END OF PAGE
          SX5    B1          INSURE NO HEADER WRITTEN 
          SX4    B1          SET NOT PAGE EJECT 
          EQ     CLCX        RETURN 
  
*         PROCESS SUPPRESS CARRIAGE ADVANCE AFTER PRINTING. 
  
 CLC9     NZ     X2,CLC11    IF NOT END OF PAGE 
          SX7    B0+
          SX6    B1          SET *EMPTY PAGE WITH HEADER* FLAG
          SA6    EPWH 
          EQ     CLC12       FORCE END OF PAGE
  
  
 CLCA     CON    0           PAGE EMPTY STATUS
 TCCC     SPACE  4,10 
**        TABLE OF CARRIAGE CONTROL CHARACTERS. 
* 
*T,TCCC   6/ CC,36/ 0,18/ LC
* 
*         CC = CHARACTER. 
*         LC = LINE COUNT TO ADD. 
  
  
 TCCC     BSS    0
          VFD    6/1L/,36/0,18/0
          VFD    6/1L2,36/0,18/0
          VFD    6/1L+,36/0,18/0
          VFD    6/1L-,36/0,18/3
          VFD    6/1L0,36/0,18/2
          VFD    6/1LS,36/0,18/-1 
          VFD    6/1LT,36/0,18/-1 
          VFD    6/1L1,36/0,18/1
 TCCCL    EQU    *-TCCC 
 HFF      SPACE  4,20 
**        HFF - OUTPUT HEAD AND FOOT SECURITY LINES FOR A 
*                FORMATTED FILE.
* 
*         ENTRY  (BUNT) = BANNER UNIT VALUE.
*                (X0) = 0 (DATA READ).
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 6. 
* 
*         CALLS  CLC, SBP, WBP. 
* 
*         MACROS READ, READC, RECALL, WRITEC, WRITEF, WRITER, WRITEW. 
* 
*         DEFINE (X0) = 0 IF DATA READ. 
*                     = -1 IF NO DATA (EOR).
*                     = -2 IF NO DATA (EOF).
  
  
 HFF      SUBR               ENTRY/EXIT 
  
*         READ FILE.
  
 HFF1     SA1    LNPG        FORCE NEW PAGE 
          BX6    X1 
          BX7    X7-X7
          SA6    LCNT 
          SA7    EPWH        CLEAR EMPTY PAGE WITH HEADER FLAG
          READ   F
          RECALL S
  
*         READ FILE LINE. 
  
 HFF2     READC  F,WBUF,WBUFL 
          ZR     X1,HFF4     IF TRANSFER COMPLETE 
          NG     X1,HFF8     IF EOF OR EOI
  
*         END OF RECORD ENCOUNTERED.
  
          SA2    LCNT        ENSURE FOOTING AT BOTTOM OF PAGE 
          SA1    LNPG 
          IX1    X1-X2
          NZ     X1,HFF3     IF HEADING ALREADY WRITTEN 
          SA1    EPWH 
          NZ     X1,HFF3     IF HEADING ALREADY WRITTEN 
          WRITEW S,HEAD,HEADL  WRITE HEADING
          SA2    LNPG 
 HFF3     BX7    X2 
          RJ     SBP         SKIP TO BOTTOM OF PAGE 
          WRITEW S,FOOT,FOOTL  WRITE FOOTING
          WRITER S
          SX0    B0+         SET DATA (EOR) READ
          SA1    BUNT 
          NZ     X1,HFF1     IF BANNER UNIT NOT RECORD
          RJ     WBP         WRITE BANNER PAGE
          SX0    -1          SET NO DATA
          EQ     HFF1        READ NEXT RECORD 
  
*         WRITE FILE LINE.
  
 HFF4     SX0    B0+         SET DATA READ
          SA1    WBUF        GET FIRST CHARACTER IN LINE
          MX2    6
          BX1    X2*X1
          RJ     CLC         CHECK LINE COUNT 
          NG     X2,HFF2     IF LINE SHOULD BE SKIPPED
          ZR     X5,HFF6     IF HEADING NOT ALREADY WRITTEN 
          NZ     X2,HFF7     IF NOT END OF PAGE 
          RJ     SBP         SKIP TO BOTTOM OF PAGE 
          WRITEW S,FOOT,FOOTL  WRITE FOOTING
 HFF6     WRITEW S,HEAD,HEADL  WRITE HEADING
 HFF7     WRITEC S,WBUF      WRITE DATA LINE
          EQ     HFF2        READ NEXT LINE 
  
 HFF8     SX1    X1+1 
          NG     X1,HFF11    IF EOI ENCOUNTERED 
          WRITEF S
          SA1    BUNT 
          SX1    X1+1 
          ZR     X1,HFF9     IF BANNER UNIT FILE
          SX1    X1-1 
          NZ     X1,HFF10    IF BANNER UNIT NOT RECORD
          SX1    X0+1 
          ZR     X1,HFF10 
 HFF9     RJ     WBP         WRITE BANNER PAGE
 HFF10    SX0    -2          SET NO DATA (EOF)
          EQ     HFF1        READ NEXT RECORD 
  
 HFF11    SA1    BUNT 
          SX2    X1+2 
          ZR     X2,HFF12    IF BANNER AT BOI/EOI 
          NG     X0,HFFX     IF NO DATA READ SINCE LAST BANNER WRITTEN
          SX2    X1-1 
          ZR     X2,HFFX     IF BANNER NOT TO BE WRITTEN
 HFF12    RJ     WBP         WRITE BANNER PAGE
          EQ     HFFX        RETURN 
 HFU      SPACE  4,20 
**        HFU - OUTPUT HEAD AND FOOT SECURITY LINES FOR AN
*                UNFORMATTED FILE.
* 
*         ENTRY  (BUNT) = BANNER UNIT VALUE.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 5, 7. 
* 
*         CALLS  CDD, SBP, SNM, WBP.
* 
*         MACROS MESSAGE, READ, READS, RECALL, WRITEF, WRITER, WRITES,
*                WRITEW.
* 
*         DEFINE (X0) = 0 IF DATA READ. 
*                     = -1 IF NO DATA (EOR).
*                     = -2 IF NO DATA (EOF).
  
  
 HFU      SUBR               ENTRY/EXIT 
          SX6    1R          ENSURE FIRST CHARACTER BLANK 
          SA6    WBUFS
  
*         READ FILE.
  
 HFU1     SA1    LNPG        FORCE NEW PAGE 
          BX6    X1 
          BX7    X7-X7
          SA6    LCNT 
          SA7    EPWH        CLEAR EMPTY PAGE WITH HEADER FLAG
          READ   F
          RECALL S
  
*         READ FILE LINE. 
  
 HFU2     READS  F,WBUF,WBUFL 
          ZR     X1,HFU4     IF TRANSFER COMPLETE 
          NG     X1,HFU8     IF EOF OR EOI
  
*         EOR ENCOUNTERED.
  
          SA2    LCNT        ENSURE FOOTING AT BOTTOM PAGE
          SA1    LNPG 
          IX1    X1-X2
          NZ     X1,HFU3     IF HEADING ALREADY WRITTEN 
          SA1    EPWH 
          NZ     X1,HFU3     IF HEADING ALREADY WRITTEN 
          WRITEW S,HEAD,HEADL  WRITE HEADING
          SA2    LNPG 
 HFU3     BX7    X2 
          RJ     SBP         SKIP TO BOTTOM OF PAGE 
          WRITEW S,FOOT,FOOTL  WRITE FOOTING
          WRITER S
          SX0    B0+         SET DATA (EOR) READ
          SA1    BUNT 
          NZ     X1,HFU1     IF NO BANNER PAGE
          RJ     WBP         WRITE BANNER PAGE
          SX0    -1          SET NO DATA
          EQ     HFU1        READ NEXT RECORD 
  
*         WRITE FILE LINE.
  
 HFU4     SX0    B0+         SET DATA READ
          SB7    WBUF+WBUFL  LWA+1 OF BUFFER
          NE     B6,B7,HFU5  IF BUFFER NOT FULL 
          SA1    LTCT        INCREMENT TRUNCATION COUNT 
          SX3    B1 
          IX7    X1+X3
          SA7    A1+
 HFU5     SA5    LCNT 
          SA2    LNPG 
          IX2    X5-X2
          ZR     X2,HFU6     IF HEADING NOT WRITTEN YET 
          NZ     X5,HFU7     IF NOT END OF PAGE 
          WRITEW S,FOOT,FOOTL  WRITE FOOTING
          SA5    LNPG        RESET LINE COUNT 
 HFU6     WRITEW S,HEAD,HEADL  WRITE HEADING
 HFU7     WRITES S,WBUFS,WBUFL  WRITE DATA LINE 
          SX7    X5-1        UPDATE LINE COUNT
          SA7    LCNT 
          EQ     HFU2        READ NEXT LINE 
  
 HFU8     SX1    X1+1 
          NG     X1,HFU11    IF EOI ENCOUNTERED 
          WRITEF S
          SA1    BUNT 
          SX1    X1+1 
          ZR     X1,HFU9     IF BANNER UNIT FILE
          SX1    X1-1 
          NZ     X1,HFU10    IF BANNER UNIT NOT RECORD
          SX1    X0+1 
          ZR     X1,HFU10    IF NO DATA (EOR) 
 HFU9     RJ     WBP         WRITE BANNER PAGE
 HFU10    SX0    -2          SET NO DATA (EOF)
          EQ     HFU1        READ NEXT RECORD 
  
 HFU11    SA1    BUNT 
          SX2    X1+2 
          ZR     X2,HFU12    IF BANNER AT BOI/EOI 
          NG     X0,HFU13    IF NO DATA READ SINCE LAST BANNER WRITTEN
          SX2    X1-1 
          ZR     X2,HFU13    IF BANNER NOT TO BE WRITTEN
 HFU12    RJ     WBP         WRITE BANNER PAGE
  
*         ISSUE LINES TRUNCATED MESSAGE.
  
 HFU13    SA1    LTCT        GET TRUNCATION COUNT 
          ZR     X1,HFUX     IF NO LINES TRUNCATED
          SX5    HFUA 
          SX2    X1-1 
          ZR     X2,HFU14    IF ONE LINE TRUNCATED
          SX5    HFUB 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          MX1    1           ENTER COUNT IN MESSAGE 
          SB2    B2-B1
          AX1    B2 
          BX1    X1*X4
          SB2    1RX
          SB5    X5+
          RJ     SNM         SET LINE COUNT IN MESSAGE
 HFU14    MESSAGE  X5,3      ISSUE LINES TRUNCATED MESSAGE
          EQ     HFUX        RETURN 
  
  
 HFUA     DATA   C* 1 LINE TRUNCATED.*
 HFUB     DATA   C* XXXXXXXXXX LINES TRUNCATED.*
 RCC      SPACE  4,10 
**        RCC - REMOVE CARRIAGE CONTROL CHARACTER.
* 
*         ENTRY  (WBUF) = LINE OF FILE. 
* 
*         EXIT   CARRIAGE CONTROL (FIRST CHARACTER) REMOVED 
*                FROM SPECIFIED LINE OF FILE. 
* 
*         USES   X - 1, 2, 4, 6.
*                A - 1, 4, 6. 
  
  
 RCC      SUBR               ENTRY/EXIT 
          SA1    WBUF        REMOVE CARRIAGE CONTROL
          MX2    6
          BX1    -X2*X1 
          SA4    BLKL        FILL HOLE WITH BLANK 
          BX6    X1+X4
          SA6    A1 
          EQ     RCCX        RETURN 
 SBP      SPACE  4,10 
**        SBP - SKIP TO BOTTOM OF PAGE. 
* 
*         ENTRY  (X7) = NUMBER OF BLANK LINES TO WRITE. 
* 
*         USES   X - 7. 
*                B - 7. 
* 
*         MACROS WRITEC.
  
  
 SBP      SUBR               ENTRY/EXIT 
          SB7    X7          NUMBER OF BLANK LINES TO WRITE 
          SX7    X7-1 
          NG     X7,SBPX     IF NO BLANK LINES NEEDED 
 SBP1     WRITEC S,BLKL      WRITE BLANK LINE 
          SB7    B7-1 
          NZ     B7,SBP1     IF MORE LINES TO WRITE 
          EQ     SBPX        RETURN 
 WBP      SPACE  4,10 
**        WBP - WRITE BANNER PAGE.
* 
*         USES   X - 1. 
*                A - 1. 
* 
*         MACROS WRITER, WRITEW.
  
  
 WBP      SUBR               ENTRY/EXIT 
          WRITEW S,BPB1,BPB1L 
          SA1    BPBL        GET BUFFER LENGTH
          WRITEW S,BPB2,X1
          WRITER S
          EQ     WBPX        RETURN 
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCARG 
*CALL     COMCBAN 
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCPM 
*CALL     COMCLFM 
*CALL     COMCRDC 
*CALL     COMCRDS 
*CALL     COMCRDW 
*CALL     COMCSFN 
*CALL     COMCSNM 
*CALL     COMCSYS 
*CALL     COMCWTC 
*CALL     COMCWTS 
*CALL     COMCWTW 
*CALL     COMCVLC 
*CALL     COMTBAN 
          TITLE  BUFFER AREA. 
          SPACE  4,10 
*         BUFFERS.
  
          USE    LITERALS 
  
  
 BPB1     BSS    0           BANNER PAGE HEADER BUFFER
          DATA   40H1 
 BPBA     DATA   28H   FILE NAME      = 
          DATA   1L 
          DATA   40H
 BPBB     DATA   30H   DATE PRINTED   = 
          DATA   1L 
          DATA   1L 
          DATA   40H
 BPBC     DATA   30H   USER NAME      = 
          DATA   1L 
          DUP    10,1 
          DATA   1L 
 BPB1L    EQU    *-BPB1 
          SPACE  4,10 
 BPB2     BSS    0           ACCESS LEVEL NAME BUFFER 
          BSSZ   401
          SPACE  4,10 
 FBUF     EQU    *           SECURED FILE BUFFER
 SBUF     EQU    FBUF+FBUFL  SCRATCH FILE BUFFER
 WBUFS    EQU    SBUF+SBUFL  SHIFTED WORKING BUFFER 
 WBUF     EQU    WBUFS+1     WORKING BUFFER 
 RFL=     EQU    WBUF+WBUFL+4  SET *SECHDR* FL
          TITLE  PRESET.
 PRS      SPACE  4,20 
**        PRS - PRESET. 
* 
*         EXIT   ARGUMENTS PROCESSED. 
*                (BUNT) = 1 IF NO BANNER PAGE TO BE WRITTEN.
*                       = 0 IF BANNER UNIT IS RECORD. 
*                       = -1 IF BANNER UNIT IS FILE.
*                       = -2 IF BANNER AT BOI/EOI.
*                (POPT) = 1 IF HEAD/FOOT TO BE WRITTEN. 
*                       = 0 IF NO HEAD/FOOT TO BE WRITTEN.
*                (BCFL) = 0 IF BACKCOPY NEEDS TO BE PERFORMED.
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 6, 7. 
*                B - 2, 4, 5. 
* 
*         CALLS  ARG, SFN.
* 
*         MACROS ABORT, FILINFO, GETPP, MESSAGE, REQUEST, RETURN, 
*                REWIND, SETFET, STATUS.
  
  
 PRS      SUBR               ENTRY/EXIT 
  
*         SET FILE NAME.
  
          SA1    ARGR 
          SX5    ERFN        * NO FILE NAME SPECIFIED.* 
          ZR     X1,PRS9     IF NO ARGUMENTS
          MX0    42 
          BX6    X0*X1
          ZR     X6,PRS9     IF NULL FILE NAME
          SA1    FIPB        SET FILE NAME IN *FILINFO* BLOCK 
          BX7    X1+X6
          SA7    A1 
          SA2    F           SET FILE NAME IN FET 
          BX3    -X0*X2 
          BX6    X3+X6
          SA6    A2+
  
*         SAVE FILE ACCESS LEVEL. 
  
          SA1    F+1         SET BIT TO RETURN FILE ACCESS LEVEL
          SX0    B1 
          LX0    39 
          BX6    X0+X1
          SA6    A1 
          STATUS F,P
          SA1    F+CFAL      GET ACCESS LEVEL 
          LX1    -36
          MX0    -3 
          BX6    -X0*X1 
          SA6    PRSB 
          SA2    TALV+X6     OBTAIN EQUIVALENT TEXT 
          MX0    42 
          BX1    X0*X2
          RJ     SFN
          SA6    HEAD+2      SET HEADLINE 
          SA6    HEAD+4 
          SA6    HEAD+6 
          SA6    HEAD+8 
          SA6    HEAD+10
          SA6    HEAD+12
          SA6    FOOT+2      SET FOOTLINE 
          SA6    FOOT+4 
          SA6    FOOT+6 
          SA6    FOOT+8 
          SA6    FOOT+10
          SA6    FOOT+12
          SA6    ALVL 
  
*         CHECK FILE TYPE AND DEVICE TYPE.
  
          FILINFO  FIPB      GET FILE INFORMATION 
          SA1    FIPB+1 
          MX0    -6          CHECK FILE TYPE
          BX2    -X0*X1 
          SX6    X2-4        (X6) = 0 IF DIRECT ACCESS FILE 
          LX1    59-16
          SX5    ERTF        * UNABLE TO PROCESS TERMINAL FILE.*
          NG     X1,PRS9     IF FILE ASSIGNED TO TERMINAL 
          LX1    59-15-59+16 CHECK DEVICE TYPE
          NG     X1,PRS1     IF FILE ON MASS STORAGE
          BX7    X7-X7       CLEAR RANDOM INDEX 
          SA7    F+CFCN 
          BX6    X6-X6
 PRS1     SA6    BCFL        SET BACKCOPY FLAG
  
*         PROCESS ARGUMENTS.
  
          SA4    ACTR 
          SB4    X4-1        SET ARGUMENT COUNT 
          SA4    ARGR+1      SET FIRST ARGUMENT 
          SB5    TARG        SET ARGUMENT TABLE FWA 
          RJ     ARG         PROCESS ARGUMENTS
          SX5    ERPR        * ERROR IN SECHDR PARAMETERS.* 
          NZ     X1,PRS9     IF ARGUMENT ERROR
  
*         PROCESS *OP* OPTIONS. 
  
          SA1    OP          CHECK OPTIONS
          MX0    6
          NZ     X1,PRS2     IF NOT DEFAULT OPTION
          SA1    DFOP 
 PRS2     BX2    X0*X1
          ZR     X2,PRS5     IF NO MORE OPTIONS SPECIFIED 
          LX1    6           POSITION NEXT OPTION 
  
*         CHECK IF LEGAL OPTION.
  
          SA4    TOPT 
 PRS3     BX3    X0*X4       CHECK OPTION 
          IX3    X3-X2
          ZR     X3,PRS4     IF LEGAL OPTION
          SA4    A4+B1
          NZ     X4,PRS3     IF MORE OPTIONS TO CHECK 
          SA1    EROP+1      SET UNKNOWN OPTION IN MESSAGE
          MX0    -6 
          LX0    6
          BX3    X0*X1
          LX2    12 
          BX6    X3+X2
          SA6    A1 
          SX5    EROP        * UNKNOWN OPTION - X.* 
          EQ     PRS9        PROCESS ERROR
  
*         SET BIT IN OPTION TABLE.
  
 PRS4     LX4    59-0 
          NG     X4,PRS2     IF OPTION PREVIOUSLY SPECIFIED 
          LX4    0-59 
          SX6    B1+
          BX6    X6+X4
          SA6    A4 
          EQ     PRS2        CHECK REMAINING OPTIONS
  
*         CHECK IF B, F, OR R OPTION SELECTED.
  
 PRS5     SA1    TOPT-1 
          SB2    B1+B1
          MX0    -1 
 PRS6     SA1    A1+B1       CHECK NEXT OPTION
          NG     B2,PRS7     IF END OF OPTIONS TO CHECK 
          SB2    B2-B1
          BX2    -X0*X1 
          ZR     X2,PRS6     IF OPTION NOT SET
          SX6    B2-B1
          SA6    BUNT        STORE BANNER UNIT
  
*         SAVE P OPTION.
  
 PRS7     SA1    TOPP 
          BX6    -X0*X1 
          SA6    POPT 
          REWIND F,R
          RETURN S,R
  
*         CREATE SCRATCH FILE WITH SAME ACCESS LEVEL. 
  
          SA1    S+1         SET FILE ACCESS LEVEL BIT
          MX0    1
          LX0    39-59
          BX6    X0+X1
          SA6    A1 
          SA2    S+CFAL 
          MX0    -3 
          LX0    36 
          SA1    PRSB        GET ACCESS LEVEL OF OLD FILE 
          BX2    X0*X2       CLEAR ACCESS LEVEL FIELD 
          LX1    36 
          BX6    X1+X2       MERGE NEW ACCESS LEVEL 
          SA6    A2 
          SETFET S,(DTY=PRSA)  REQUEST MASS STORAGE RESIDENCE 
          REQUEST  S,U,N     REQUEST FILE WITH NO DAYFILE MESSAGE 
          GETPP  PRSC,LNPG,PDEN  GET PAGE INFORMATION 
          SA1    POPT 
          SX3    1
          SA2    LNPG        SET PAGE SIZE
          ZR     X1,PRS8     IF NO HEADERS REQUESTED
          SX3    SHFL+1      ALLOW ROOM FOR HEADERS 
 PRS8     IX6    X2-X3
          SA6    A2 
          EQ     PRSX        RETURN 
  
*         PROCESS ERRORS. 
  
 PRS9     MESSAGE  X5        ISSUE ERROR MESSAGE
          ABORT 
  
 PRSA     CON    2RMS        MASS STORAGE DEVICE RESIDENCE
 PRSB     CON    0           ACCESS LEVEL 
 PRSC     BSSZ   2           *GETPP* BUFFER 
  
*         ARGUMENT TABLE. 
  
 TARG     BSS    0
 FF       ARG    -NZ,FORM 
 OP       ARG    OP,OP
          ARG 
  
  
*         OPTION TABLE. 
*         THE OPTIONS IN THIS TABLE MUST REMAIN IN THIS ORDER.
  
 TOPT     BSS    0
          DATA   1LR
          DATA   1LF
 DFOP     DATA   1LB
 TOPP     DATA   1LP
          CON    0           END OF OPTION TABLE
  
  
*         CONSTANTS.
  
 NZ       CON    1           NON-ZERO 
 OP       CON    0           OPTION 
  
*         PARAMETER BLOCK.
  
 FIPB     BSS    0           *FILINFO* PARAMETER BLOCK
          VFD    42/0,6/5,12/1
          BSSZ   4
  
*         ERROR MESSAGES TO DAYFILE.
  
 ERFN     DATA   C* NO FILE NAME SPECIFIED.*
 EROP     DATA   C* UNKNOWN OPTION - X.*
 ERPR     DATA   C* ERROR IN SECHDR PARAMETERS.*
 ERTF     DATA   C* UNABLE TO PROCESS TERMINAL FILE.* 
          SPACE  4
          END    SECHDR 
