Retro1.org codex

          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