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