* 02/13/76  --  10:00
* MODULE NAME: WSCTRL
* NUMBER: 3
* PURPOSE: INITIALIZE AND MAINTAIN WORKING STORAGE
*
* ENTRY POINTS
         DEF      C03TABS,S03NXTAB  TAB SETTINGS
         DEF      S03ZTABS          INITIALIZE TAB SETTINGS
         DEF      C03WIDTH          SET WIDTH,DEPTH,PDEPTH
         DEF      C03TU,C03TF       SET FORMATTING MODE
         DEF      C03TUH,C03TUF     HEADING,FOOTING MODES
         DEF      C03TE,C03TEND,C03TC  SET HEADER WORD
         DEF      C03TSTKT,C03TEKT  SET HEADER WORD
         DEF      C03CLEAR          CLEAR WORKING STORAGE
         DEF      C03QM,S03QM       PRINT SYSTEM STATUS
         DEF      C03CLP            SET CURRENT LINE POINTER
         DEF      S03LOGON          SET LOGON STATUS
         DEF      S03RESWS,S03WMREC RESET WS FILES, WRITE MASTER RECORD
         DEF      S03OPNPR,S03CLSPR  OPEN,CLOSE PR FILE
         DEF      S03RELPR,S03SETPR RELEASE, RESET PRINT FILE
         DEF      C03CRED,CREDFLG   'TEXT' CREDIT FLAG
         DEF      S03LFMT           FIND PREVIOUS FORMAT
         DEF      S03FCHAR          FIND A CHARACTER IN A STRING
         DEF      SZWSNAME          SIZE OF WS FILE NAMES
         DEF      S03BWSCK          SET UP BATCH WS FILES
         DEF      C03TW,E03TW       TEMPORARY WIDTH COMMAND
         DEF      TEMPW             TEMPORARY WIDTH WORD
*
         REF      S27CHDR,S27CTXT
         REF      S15CLEAR,S29STD,S35CNVRT,S27PRINT
         REF      F:HDR,F:TXT,J:UNAME
         REF      F:CPY             F:CPY DCB
         REF      BATCHFLG          BATCH MODE FLAG
         REF      S27OPEN,S27CLOSE,S27WHDR,S27RHDR
         REF      S27OCPY,S27CCPY   OPEN,CLOSE COPY FILE (PRINT FILE)
         REF      S05NLMSG,S05GETLN
         REF      C06FIND
         REF      S27UCTAB
         REF      S27TXTLL
         REF      S36M:TIME         GET DATE AND TIME
         REF      S36M:EXIT
         REF      S08SCMD           NEW FORMATTING COMMAND
         REF      S27END            RESTORE M:UC PARAMETERS
*
         REF      CMDERRFG          COMMAND ERROR FLAG
*
*
         PAGE
*
*
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
            INVCMDSTA
            INVWSSTA
            INVHDRSTA
         INVLNSTA
                  INVDCBTBL
*
*
         DEF      3P,3D
*
3P       EQU      %                 START OF PROCEDURE
         DATA     X'03'             MODULE NUMBER
         DATA     X'021376'         DATE
         DATA     X'1000'           TIME
*
*
*
         TITLE    '** WSCTRL(3) **'
         PAGE
*
*
* CLEAR WORKING STORAGE
*
C03CLEAR EQU      %
         SAVRTN
*
         LI,X1    3                 CHECK FLAGS 1-3 FOR AUX. FILE CLEAR
AFTST    EQU      %
         JNEZ,D1  (#FLAGS,X1),AFCLR TEST FLAGS
         BDR,X1   AFTST
*
WSCLR    EQU      %
         LI,AC1   #REL              CLOSE AND RELEASE WS FILES
         BAL,SRTN S27CHDR              HEADER FILE
         LI,AC1   #REL
         BAL,SRTN S27CTXT              TEXT FILE
*
         BAL,SRTN S03RESWS          RESET WS PARAMETERS AND OPEN FILES
*
         LI,AC1   23                'CLEARED' MESSAGE
         BAL,SRTN S29STD
*
         LI,AC1   1                 'UNFORMATTED MODE' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         LI,X1    0                 SET AUX FILE CLEAR ALL
AFCLR    EQU      %                 CLEAR AUX FILE(S)
         BAL,SRTN S15CLEAR
         RETURN
*
*
         PAGE
*
* SET UP LOGON CONDITIONS -- PRINT STATUS MESSAGES
*
S03LOGON EQU      %
         SAVRTN
*
         BAL,SRTN S03RESWS          RESET WS PARAMETERS AND OPEN FILES
         MTW,0    EXSTFLG           TEST FOR WS FILES EXISTENCE
         BNEZ     PRNTQM               YES, PRINT STATUS
         LW,D1    WLPINIT           GET INITIALIZATION FOR WIDTH, ETC.
         STWC,D1  #WIDTH            STORE IN WIDTH,DEPTH WORD
*
         BAL,SRTN S03ITABS          INITIALIZE TAB SETTINGS
         B        PRNTQM            GO PRINT STATUS
*
*
         PAGE
*
*
PRNTQM   EQU      %
         LI,AC1   #OUT              OPEN PR FILE IN OUT MODE
         BAL,SRTN S03OPNPR
         LI,AC1   #SAVE             CLOSE AND SAVE PR FILE
         BAL,SRTN S27CCPY
         LI,AC1   0                 RESET PRN EXISTENCE FLAG
         STW,AC1  PRNEXFLG
         MTW,0    BATCHFLG          BATCH MODE
         BGZ      PRNTQM5           YES, SKIP M:UC TABS
         BAL,SRTN S27UCTAB          SET M:UC TABS
         B        PRNTQM7
PRNTQM5  RES      0
         PUT,AC1  #PRNTFLG          INHIBIT PRINTOUT
PRNTQM7  RES      0
         BRKCTRL  0                 INITIALIZE BREAK CONTROL
         LI,AC3   :ADEO(WS:TIME)    GET ADDR FOR DATE/TIME
         BAL,SRTN S36M:TIME         GET DATE/TIME IN WS STATUS
         MOVE,X1  BA(WSNAM)+4,BA(STDPRBUF),12  MOVE OP ID TO MSG
         LI,X1    BA(SGNONMSG)+1    GET ADDR OF 'SIGNED-ON' MSG
         LB,AC1   SGNONMSG          GET SIZE
         STB,AC1  X2                COUNT FOR MBS
         MBS,X1   0                 MOVE MSG TO BUFFER
*
         LI,X1    :ADEO(WS:TIME)    GET WA OF DATE/TIME
         SLS,X1   2                 CONVERT TO BA
         LI,AC1   16                NUMBER OF CHARS
         STB,AC1  X2                COUNT FOR MBS
         MBS,X1   0                 MOVE DATE/TIME TO BUFFER
*
*
         PAGE
*
*
         LI,AC2   #CR               STORE CR AT END
         STB,AC2  0,X2
         AI,X2    -BA(STDPRBUF)+1   CALC SIZE OF MSG
         LI,BUF1  BA(STDPRBUF)      GET ADDR OF MSG
         LW,AC1   X2                GET SIZE
         BAL,SRTN S27PRINT          PRINT MESSAGE
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     LOGONNL              SET, SKIP STATUS
*
         BAL,SRTN S03QMLOG          PRINT WIDTH,DEPTH,TABS
         BAL,SRTN S03LFMT           PRINT FORMAT MESSAGE
*
LOGONNL  EQU      %
         BAL,SRTN S05NLMSG          PRINT NEXT LINE NUMBER
         BAL,SRTN S03WMREC          WRITE MASTER RECORD
         LW,D1    BATCHFLG          BATCH MODE
         BLEZ     LOGONNL3          NO
         PUT,D1   #PRNTFLG          ENABLE PRINTOUT
LOGONNL3 RES      0
         RETURN
*
WLPINIT  DATA,1   0,60,54,66        INIT WORD FOR W,D,LD
SGNONMSG TEXTC    ' SIGNED-ON '
*
*
         PAGE
*
* WIDTH,DEPTH SETTINGS
*
C03WIDTH EQU      %
         SAVRTN
*
         LWC,D1   #WLPBASE          GET CURRENT WIDTH,DEPTH
         STW,D1   WLPSAVE           SAVE CURRENT SETTINGS
         LI,X1    3                 WIDTH/DEPTH FLAGS
WDTST    EQU      %
         JEZ,D1   (#FLAGS,X1),DECRWD TEST COMMAND FLAGS
         GET,D1   #DSHW,X1          GET VALUE
         CLM,D1   MINMAX,X1         TEST MIN/MAX LIMITS
         BCS,9    ILLWD                OUTSIDE LIMITS, ERROR
         STB,D1   WLPSAVE,X1        NEW WIDTH,DEPTH SETTING
DECRWD   EQU      %
         BDR,X1   WDTST             TEST NEXT FLAG
RTNWIDTH EQU      %
         LW,D1    WLPSAVE           GET NEW SETTINGS
         STWC,D1  #WIDTH            STORE NEW SETTINGS
         BAL,SRTN S03WMREC          WRITE MASTER RECORD
         RETURN
*
*
         PAGE
*
*
ILLWD    EQU      %                 ILLEGAL WIDTH/DEPTH SETTING
         LI,AC1   35                'WIDTH/DEPTH OUTSIDE LIMITS'
ILLWD5   RES      0
         BAL,SRTN S29STD            PRINT MESSAGE
         LI,AC1   6                 'ACTION CANCELLED'
         BAL,SRTN S29STD            PRINT MESSAGE
         RETURN
*
*
*
         BOUND    8
MINMAX   EQU      %-2               MIN/MAX LIMITS FOR WIDTH,DEPTH
WLIMIT   DATA     5,140             WIDTH MIN/MAX
         DATA     5,98              DEPTH MIN/MAX
         DATA     5,98              CONTINUOUS-FORM MIN/MAX
         PAGE
*
*
* C03TW -- TEMPORARY WIDTH COMMAND (WHEN ENTERED)
*
C03TW    RES      0
         SAVRTN
         JEZ,D1   (#FLAGS,:K(1)),CTW500  EXIT IF NO WIDTH
         GET,D1   #DSHW,:K(1)       GET TEMP WIDTH
         CLM,D1   WLIMIT            CHECK MIN/MAX LIMITS
         BCS,9    TWERR             ERROR
CTW500   RES      0
         RETURN
*
*
* E03TW -- TEMPORARY WIDTH COMMAND (UPON PRINTOUT)
*
E03TW    RES      0
         SAVRTN
         BAL,SRTN S08SCMD           NEW FORMATTING COMMAND
         LW,D1    TEMPW             GET PERM WIDTH
         BEZ      TW20              NONE SAVED
         PUT,D1   #WIDTH            RESTORE AS PERM WIDTH
         PUT,D1   LN:MXPSTN         SET MAX WIDTH FOR FORMATTING
         LI,AC1   0
         STW,AC1  TEMPW             RESET SAVED WIDTH
TW20     RES      0
         JEZ,D1   (#FLAGS,:K(1)),ETW500  EXIT IF NO TEMP WIDTH
         GET,D1   #DSHW,:K(1)       GET TEMP WIDTH
         CLM,D1   WLIMIT            CHECK MIN/MAX LIMITS
         BCS,9    TWERR5            ERROR
         GET,D2   #WIDTH            GET PERM WIDTH
         STW,D2   TEMPW             SAVE
         PUT,D1   #WIDTH            SET NEW WIDTH
         PUT,D1   LN:MXPSTN         SET MAX WIDTH FOR FORMATTING
ETW500   RES      0
         RETURN
*
*
TWERR    RES      0
         MTW,1    CMDERRFG          SET COMMAND ERROR FLAG
TWERR5   RES      0
         LI,AC1   67                'OUTSIDE LIMITS MSG'
         B        ILLWD5
         PAGE
*
*
* PRINT CURRENT TERMINAL STATUS
*
S03QM    EQU      %
         SAVRTN
*
         MTW,0    BRKFLAG           TEST BREAKFLAG
         BNEZ     RTNQM                SET, RETURN
         LI,X2    3
GETSTA   EQU      %
         GET,AC1  #WLPBASE,X2       GET WIDTH,DEPTH OPTIONS
         BAL,SRTN S35CNVRT          CONVERT TO EBCDIC
         STW,AC2  WLPBASE,X2        SAVE
         BDR,X2   GETSTA            GET NEXT IF MORE
*
         MOVE,AC1 BA(WIDTH),INSWIDTH,4   MOVE WIDTH TO MESSAGE
         MOVE,AC1 BA(DEPTH),INSDEPTH,4   MOVE DEPTH TO MESSAGE
         MOVE,AC1 BA(PDEPTH),INSCFD,4    MOVE C-F DEPTH TO MESSAGE
         LI,BUF1  BA(WDMSG)         PRINT LINE
         LB,AC1   0,BUF1
         AI,BUF1  1
         BAL,SRTN S27PRINT
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     RTNQM                SET, RETURN
*
         PAGE
*
*
         JEZ,D1   WS:NTABS,RTNQM    GET NUMBER OF TABS SET
         CI,D1    WS:MXTABS         TEST FOR ERROR
         BLE      INSDASHS             NO, INSERT DASHES IN BUFFER
TABSINIT EQU      %
         BAL,SRTN S03ITABS          INITIALIZE TAB SETTINGS
*
INSDASHS EQU      %
         INSCHAR  '-',BA(STDINBUF)+1,#LSTCOL-1  INSERT DASHES IN BUFFER
         LI,AC1   LC('T')           GET L.C. 'T'
         LI,X3    1                 START WITH FIRST TAB SETTING
*
INSNXTAB EQU      %
         GET,X1   WS:TABS,X3        GET COLUMN FOR NEXT TAB
         STB,AC1  STDINBUF,X1       STORE 'T' TO CORRESPOND
         CI,X1    #LSTCOL           TEST FOR ERROR
         BGE      TABSINIT             YES, RE-INITIALIZE TABS
         AI,X3    1                 INCREMENT TAB INDEX
         BDR,D1   INSNXTAB          GET ALL TABS
*
         AI,X1    1                 ONE AFTER LAST TAB COLUMN
         LI,AC1   #CR               GET CR CHAR
         STB,AC1  STDINBUF,X1       STORE IN BUFFER
         LW,AC1   X1                GET SIZE FOR WRITE
         LI,BUF1  BA(STDINBUF)+1    ADDR FOR WRITE
         BAL,SRTN S27PRINT          PRINT TABS LINE
*
RTNQM    EQU      %
         RETURN
*
*
         PAGE
*
*
C03QM    EQU      %
         SAVRTN
*
         BRKCTRL  0                 INITIALIZE BREAK CONTROL
         B        CQM               NOW PRINT WIDTH, ETC.
*
S03QMLOG EQU      %
         SAVRTN
CQM      EQU      %
*
         BAL,SRTN S03QM             PRINT WIDTH,DEPTH,TABS
         JEZ,X1   WS:NTABS,RTNCQM   GET NUMBER OF SYSTEM TABS
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     RTNCQM               SET, RETURN
         STW,X1   TMPSZ             SAVE COUNT
         LI,AC1   X'05A3'           GET TAB-T SEQUENCE
*
STSEQLP  EQU      %
         STH,AC1  STDINBUF,X1       STORE IN BUFFER
         BDR,X1   STSEQLP           STORE ONE 'T' FOR EACH TAB
*
         LW,X1    TMPSZ             GET TOTAL NUMBER
         AI,X1    1                 ADD ONE FOR CR
         LI,AC1   X'0D0D'           GET CR CHARS
         STH,AC1  STDINBUF,X1       STORE IN BUFFER
*
         LW,AC1   X1                GET SIZE FOR WRITE
         SLS,AC1  1                 CONVERT TO BYTES
         LI,BUF1  BA(STDINBUF)+2    ADDR FOR WRITE
         BAL,SRTN S27PRINT          PRINT TAB SETTINGS
*
RTNCQM   EQU      %
         RETURN
*
*
         PAGE
*
* C03TABS -- TABS COMMAND
*
C03TABS  EQU      %
         SAVRTN
         BAL,SRTN S03ZTABS          INITIALIZE TAB SETTINGS
         GET,X2   #CMDST            GET ADDR OF FIRST CHAR
         GET,D2   #NCHCMD           GET NUMBER OF CHARS
         LI,X1    0                 INITIALIZE NUMBER OF TABS
         LI,D1    1                 INITIALIZE COLUMN NUMBER
*
TSTNXTAB EQU      %
         LB,AC2   0,X2              GET NEXT CHAR
         CI,AC2   LC('T')           TEST FOR L.C. 'T'
         BE       STNXTTAB             YES, SET NEXT TAB
         CI,AC2   'T'               TEST FOR U.C. 'T'
         BNE      INCRTAB              NO, INCR POINTER
*
STNXTTAB EQU      %
         AI,X1    1                    YES, INCREMENT TAB COUNT
         PUT,D1   WS:TABS,X1        STORE COLUMN NUMBER
         CI,X1    WS:MXTABS         TEST FOR MAX NUMBER OF TABS
         BGE      LSTAB                YES, LAST TAB
*
INCRTAB  EQU      %
         AI,X2    1                 INCREMENT TAB LINE POINTER
         AI,D1    1                 INCREMENT COLUMN NUMBER
         CW,D1    D2                TEST FOR END-OF-COMMAND
         BL       TSTNXTAB             NO, GET NEXT TAB
*
LSTAB    EQU      %
         PUT,X1   WS:NTABS          STORE NUMBER OF TABS
         MTW,0    BATCHFLG          BATCH MODE
         BGZ      TBWMREC           YES
         BAL,SRTN S27UCTAB          SET DCB TABS
TBWMREC  RES      0
         BAL,SRTN S03WMREC          RE-WRITE MASTER RECORD
         RETURN
         PAGE
*
* S03ZTABS -- INITIALIZE TAB SETTINGS TO ALL ZERO
*
*
S03ZTABS EQU      %
         SAVRTN
*
         LI,X1    :ADEO(WS:TABS)-1  GET BASE WORD FOR TABS
         LI,AC1   0                 SET TO ZERO
         LI,AC2   WS:SZTABS         NUMBER OF WORDS FOR TABS
*
ZTABLP   EQU      %
         STW,AC1  *AC2,X1           SET TAB WORD TO ZERO
         BDR,AC2  ZTABLP            ZERO ALL OF THEM
         RETURN
*
*
S03ITABS EQU      %                 INITIALIZE TAB SETTINGS TO
*                                   COLUMNS 2 AND 62
         SAVRTN
*
         BAL,SRTN S03ZTABS          ZERO PREVIOUS SETTINGS
         LI,D1    5                 SET FIRST TAB TO COLUMN 5
         PUT,D1   WS:TABS,:K(1)
         LI,D1    62                SET LAST TAB TO COLUMN 62
         PUT,D1   WS:TABS,:K(2)
         LI,D1    2                 SET TAB COUNT TO 2
         PUT,D1   WS:NTABS
*
         RETURN
*
*
         PAGE
*
* S03NXTAB -- FIND NEXT TAB SETTING
*
* ENTRY: X3 = CURRENT COLUMN NUMBER
*
* EXIT: X3 = LAST COLUMN SEARCHED
*       SR3= 0 IF TAB FOUND
*          = 1 IF NOT FOUND
*
S03NXTAB EQU      %
         SAVRTN
*
         LI,X4    1                 INITIALIZE COLUMN COUNT
         JEZ,D2   WS:NTABS,TABNTFND GET NUMBER OF TABS SET
*
CMPNXTAB EQU      %
         GET,D1   WS:TABS,X4        GET COLUMN FOR NEXT TAB
         CW,D1    X3                COMPARE TO STARTING COLUMN
         BG       TABFND               GREATER, TAB FOUND
         AI,X4    1                 INCREMENT COLUMN POINTER
         BDR,D2   CMPNXTAB          TEST ALL TAB SETTINGS
*
TABNTFND EQU      %
         LI,X3    #LSTCOL           SET TO LAST COLUMN
         LI,SR3   1                 SET ERROR INDICATION
         B        RTNNXTAB          RETURN
*
TABFND   EQU      %
         LW,X3    D1                MOVE COLUMN NUMBER TO X3
         LI,SR3   0                 NO ERROR
*
RTNNXTAB EQU      %
         RETURN
         PAGE
*
* SET FORMATTING MODES
*
*
C03TU    EQU      %
         LI,D1    1                 UNFORMATTED MODE
         LI,AC1   1                 'UNFORMATTED MODE' MESSAGE
         B        SETMODE
*
C03TF    EQU      %
         LI,D1    2                 FORMATTED MODE
         LI,AC1   2                 'FORMATTED MODE' MESSAGE
         B        SETMODE
*
C03TUH   EQU      %
         LI,D1    -1                HEADING MODE
         LI,AC1   3                 MESSAGE
         B        SETMODE
*
C03TUF   EQU      %
         LI,D1    -2                FOOTING MODE
         LI,AC1   4                 MESSAGE #
*
*
         PAGE
*
*
SETMODE  EQU      %
         SAVRTN
*
         PUT,D1   HDR:FMTCDE        SAVE FORMAT CODE
         PUT,D1   #LSTFMT           SAVE LAST FORMAT SETTING
         LI,D1    X'B'              SET HEADER WORD END CODES
         PUT,D1   HDR:CMDCDE
         GET,D1   #FLAGS,:K(1)      GET CENTERING FLAG
         PUT,D1   HDR:CTRFLG        STORE IN HEADER WORD
         BAL,SRTN S29STD            NOW PRINT MESSAGE
         RETURN
*
*
         PAGE
*
* SET HEADER WORD END CODES FOR VARIOUS COMMANDS
*   THAT HAVE NO OTHER IMMEDIATE ACTION
*
C03TE    EQU      %                 END OF BLOCK DEFINITION
         LI,D1    X'F'              TABLE END, H/F END, BLOCK END
         B        SETCCDE           GO SET HEADER END CODES
*
C03TEND  EQU      %                 END OF TABLE ROW OR COLUMN
         LI,D1    9                 TABLE ROW OR COLUMN, H/F END
         B        SETCCDE           GO SET HEADER END CODES
*
C03TC    EQU      %                 BLOCK CALLOUT
C03TSTKT EQU      %                 START KEEP-TOGETHER
C03TEKT  EQU      %                 END KEEP-TOGETHER
         LI,D1    X'B'              TABLE END, H/F END
*
SETCCDE  EQU      %
         SAVRTN
         PUT,D1   HDR:CMDCDE        SET HEADER WORD COMMAND CODES
         RETURN
*
*
         PAGE
*
* RESET WORKING STORAGE
*
*
S03RESWS EQU      %
         SAVRTN
*
         LI,D1    BA(WSNAM)         GET BA OF DOC NAME BUFFER
         PUT,D1   #DOCNM            STORE IN DOC NAME FOR OPEN
*
         LW,AC1   BATCHFLG          BATCH/ON-LINE
         BLEZ     RESWS10           ON-LINE
         LI,AC1   8                 SET UP A COUNT OF 8
         B        RESWS20
RESWS10  RES      0
*
         LCI      3
         LM,AC1   J:UNAME           GET OPERATOR NAME
         STM,AC1  WSNAM+1           STORE IN 2-4 WORDS OF FILE NAME
*
         LI,X1    BA(WSNAM)+4       GET ADDR TO START SEARCH FOR BLANK
         LI,AC2   12                NUMBER OF CHARS TO SEARCH
         LI,AC3   #BLANK            CHARACTER TO SEARCH FOR
         BAL,SRTN S03FCHAR          GO FIND THE FIRST BLANK
         AI,AC1   4                 ADD 4 TO SIZE FOR 'TXT:'
RESWS20  RES      0
         STW,AC1  SZWSNAME          SAVE SIZE OF WS FILE NAMES
         PUT,AC1  #NCDOCNM          SET UP SIZE OF FILE NAME
*
         LI,D1    0
         PUT,D1       #NCACCT       NO ACCT
         PUT,D1   #NCGETPW          NO PASSWORD
*
*
         PAGE
*
*
         LI,AC1   1
         STW,AC1  EXSTFLG           INITIALIZE EXISTENCE FLAG
*
TSTWS    EQU      %
         LI,AC1   1
         STW,AC1  COUNT             INITIALIZE COUNT
         LW,AC2   L('HDR:')         START WITH HDR FILE
         LI,AC3   F:HDR             DCB ADDR
*
TSTWSLP  EQU      %
         STW,AC2  WSNAM             SET FIRST WORD OF NAME
         LI,AC1   #INOUT            OPEN FILES IN UPDATE MODE
         BAL,SRTN S27OPEN
         CI,SR3   0                 TEST ERROR INDICATOR
         BNE      NEWWS                SET, NEW WS FILES
*
         MTW,-1   COUNT             DECREMENT COUNT
         BLZ      DRECZ             DONE, GO TEST EXISTENCE FLAG
         LW,AC2   L('TXT:')         NOW OPEN TEXT FILE
         LI,AC3   F:TXT             DCB ADDR
         B        TSTWSLP
*
*
         PAGE
*
*
NEWWS    EQU      %
         CI,SR3   3                 TEST FOR NO FILE
         BE       SETEXFLG             NO FILE, SET EXST FLAG
         CI,SR3   X'14'             TEST FOR ANOTHER USER
         BNE      WSFILERR             NO, WS FILE ERROR
         CI,SR4   1                 IS SUB CODE = 1
         BNE      WSFILERR          NO, WS FILE ERROR
         LI,AC1   37                'ANOTHER USER' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         B        WSFILER3          GO EXIT
*
WSFILERR EQU      %
         LI,AC1   46                "BAD WS FILE" MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
WSFILER3 RES      0
         BAL,SRTN S27END            RESTORE M:UC PARAMETERS
         B        S36M:EXIT         EXIT PROGRAM
*
SETEXFLG EQU      %
         LI,AC1   0
         STW,AC1  EXSTFLG           RESET EXISTENCE FLAG
         LI,AC1   #REL              CLOSE AND RELEASE HDR FILE
         BAL,SRTN S27CHDR
         LI,AC1   #REL              CLOSE AND RELEASE TXT FILE
         BAL,SRTN S27CTXT
*
         LI,AC1   1
         STW,AC1  COUNT             INITIALIZE FILE COUNT
         LW,AC2   L('HDR:')         START WITH HEADER FILE
         LI,AC3   F:HDR             GET ADDR OF DCB
*
RESWSLP  EQU      %
         STW,AC2  WSNAM             SET FIRST WORD OF FILE NAME
         LI,AC1   #OUT              OPEN FILE IN OUTPUT MODE FIRST
         BAL,SRTN S27OPEN
         LI,AC1   #SAVE             NOW CLOSE WITH SAVE
         BAL,SRTN S27CLOSE
         MTW,-1   COUNT             DECREMENT AND TEST COUNT
         BLZ      TSTWS             NO MORE FILES
*
         LW,AC2   L('TXT:')         SECOND FILE IS TEXT FILE
         LI,AC3   F:TXT             DCB ADDR
         B        RESWSLP           GO OPEN
*
*
         PAGE
*
*
DRECZ    EQU      %
*
         MTW,0    EXSTFLG           TEST FILE EXISTENCE FLAG
         BEZ      SETWSSTA             NO, RESET WS TABLE
*
         LI,BUF2  BA(WSSTA)            YES, READ MASTER REC
         LI,AC1   SZWSSTA*4         GET SIZE
         LW,AC2   L(#ZROKEY)        KEY=0.0
         BAL,SRTN S27RHDR           READ HEADER FILE
         GET,D1   *#ARS             GET SIZE OF OLD MASTER RECORD
         CI,D1    SZWSSTA*4         COMPARE TO CURRENT SIZE
         BE       RTNRESWS          EQUAL
         LI,D1    0
         STWC,D1  WS:MEMO           ZERO OUT MEMO-MODE FLAGS
         B        RTNRESWS          RETURN
*
SETWSSTA EQU      %
         LI,X1    #SZKEYS           GET NUMBER OF KEYS TO INIT
         LW,D1    L(#ZROKEY)        SET KEYS TO 0.0
*
RESKEYLP EQU      %
         PUT,D1   #WKEYS,X1         STORE IN KEY
         BDR,X1   RESKEYLP          NEXT KEY
         LW,D1    L(#FSTKEY)        SET FIRST KEY VALUE
         PUT,D1   #FKEY
*
*
         PAGE
*
*
         LI,X1    SZWSINIT          SIZE OF WS INITIALIZATION
         LI,D1    0
*
INITWSLP EQU      %
         PUT,D1   #WSINIT,X1        SET ENTRIES TO ZERO
         BDR,X1   INITWSLP          NEXT ENTRY
*
         LI,D1    1
         PUT,D1   #PRNTFLG          SET PRINT FLAG
         LW,D1    L(#OVFLKEY)       SET FIRST OVERFLOW KEY
         PUT,D1   #NXTOVFL
*
         BAL,SRTN S03WMREC          NOW WRITE MASTER RECORD
RTNRESWS EQU      %
         DEPZ,D1  WS:FORM           RESET FORM-LETTER FLAG
         LCI      3                 SET OPERATOR ID IN WS STATUS
         LM,AC1   J:UNAME
         STM,AC1  :ADEO(WS:OPID)
         RETURN
*
*
         PAGE
*
*
* S03BWSCK -- SET UP BATCH WORKING STORAGE FILES
*
S03BWSCK RES      0
         SAVRTN
         MTW,0    BATCHFLG          BATCH MODE
         BLEZ     BWSCK900          NO, EXIT
         LI,AC1   0                 INIT TO ZERO
         STW,AC1  WSNAM+1             2ND WORD OF WS FILE NAMES
         LI,D1    BA(WSNAM)         GET BA OF WS NAMES
         PUT,D1   #DOCNM            SAVE FOR OPEN
         LI,AC1   8                 SET UP SIZE OF WS FILE NAMES
         STW,AC1  SZWSNAME          SAVE FOR LATER
         PUT,AC1  #NCDOCNM          SAVE FOR OPEN
         LI,D1    0
         PUT,D1   #NCACCT           SET UP NO ACCT
         PUT,D1   #NCGETPW          SET UP NO PASSWORD
*
BWSCK30  RES      0
         LI,AC1   2                 SET UP LOOP COUNT
         STW,AC1  COUNT             SAVE
BWSCK40  RES      0
         LW,X1    COUNT             SET UP INDEX
         LW,AC2   FILETBL,X1        GET NEXT FILE NAME
         LW,AC3   DCBTBL,X1         GET NEXT DCB
         STW,AC2  WSNAM             STORE 1ST WORD OF FILE NAME
         LI,AC1   #INOUT            SET OT OPEN INOUT
         BAL,SRTN S27OPEN           OPEN WS FILE
         CI,SR3   0                 ANY ERRORS
         BNE      BWSCK60           YES
BWSCK50  RES      0
         LI,AC1   #SAVE             FILE EXISTS, CLOSE WITH SAVE
         BAL,SRTN S27CLOSE          CLOSE FILE
         MTW,1    WSNAM+1           TRY NEXT SET OF WS FILES
         B        BWSCK30
*
BWSCK60  RES      0
         CI,SR3   3                 NON-EXISTANT FILE
         BNE      BWSCK50           NO, SOME OTHER ERROR
         MTW,-1   COUNT             DECR COUNT
         BGEZ     BWSCK40           CONTINUE
BWSCK900 RES      0
         RETURN
*
*
FILETBL  EQU      %
         TEXT     'PRN:'
         TEXT     'TXT:'
         TEXT     'HDR:'
*
DCBTBL   EQU      %
         DATA     F:CPY
         DATA     F:TXT
         DATA     F:HDR
*
         PAGE
*
* S03FCHAR -- FIND A SPECIFIC CHARACTER IN A STRING
*
* ENTRY PARAMETERS:  X1  = BYTE ADDR OF FIRST CHARACTER IN STRING
*                    AC2 = MAX NUMBER OF CHARS TO SEARCH
*                    AC3 = CHARACTER TO SEARCH FOR (RIGHT-JUSTIFIED)
*
* EXIT PARAMETERS:   X1  = ADDR OF CHARACTER IF FOUND
*                          0 IF NOT FOUND
*                    AC1 = NUMBER OF CHARACTERS SEARCHED (PRIOR TO CHAR)
*
S03FCHAR EQU      %
         SAVRTN
*
         LI,AC1   0                 INITIALIZE CHARACTER COUNT
SRCHLOOP EQU      %
         CB,AC3   0,X1              TEST FOR CHARACTER
         BE       SRCHRTN              FOUND, RETURN
         AI,AC1   1                    NOT FOUND, INCR SEARCH COUNT
         AI,X1    1                 INCR CHARACTER POINTER
         BDR,AC2  SRCHLOOP          TEST MAX COUNT AND CONTINUE SEARCH
         LI,X1    0                 CHARACTER NOT FOUND, SET NEXT ADDR TO ZERO
*
SRCHRTN  EQU      %
         RETURN                     RETURN TO CALLING PROGRAM
*
*
         PAGE
*
* C03CLP -- SET CURRENT LINE POINTER
*
C03CLP   EQU      %
         SAVRTN
*
         JEZ,AC1  #LN,RSCLP         TEST FOR LINE NUMBER
         BAL,SRTN S05GETLN          GET ACTUAL KEY
         LW,AC1   AC2               MOVE KEY TO AC1
         BNEZ     SETCLP            NON-ZERO, SET CLP
*
         LI,AC1   11                'ILLEGAL LINE' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         LI,AC1   6                 'ACTION CANCELLED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         B        RTNCLP            RETURN
*
RSCLP    EQU      %
         JEZ,AC1  (#FLAGS,:K(2)),RTNCLP  TEST 'R' FLAG
         GET,AC1  #LKEY             GET LAST KEY IN DOCUMENT
*
SETCLP   EQU      %
         PUT,AC1 #CLP               SAVE NEW VALUE IN CLP
*
RTNCLP   EQU      %
         LI,D1    0
         STWC,D1  #CS,:K(3)         SET FIND PHRASE TO 0
         BAL,SRTN C06FIND           GO PRINT CLP MESSAGE
         RETURN
*
*
         PAGE
*
*
S03WMREC EQU      %                 WRITE HEADER FILE RECORD 0.0
         SAVRTN
*
         LW,D1    L(#MRCODE)        SET MASTER RECORD CODE
         PUT,D1   WS:TXTCODE
         LI,BUF3  BA(WSSTA)         GET ADDR OF WS STATUS
         LI,AC1   SZWSSTA*4         GET SIZE (IN BYTES)
         LW,AC2   L(#ZROKEY)        KEY = 0.0
         BAL,SRTN S27WHDR           GO WRITE RECORD
         RETURN
*
*
         PAGE
*
* S03OPNPR -- OPEN PRINT FILE
*
* ENTRY PARAMETER: AC1=MODE
*
S03OPNPR EQU      %
         SAVRTN
*
         CI,AC1   #INOUT            TEST FOR UPDATE MODE
         BNE      OPNPRFLE             NO, OPEN PR FILE
         LI,SR3   3                    YES, SET ERROR RETURN
         MTW,0    PRNEXFLG          TEST PR EXISTENCE FLAG
         BEZ      RTNOPNPR             RESET, RETURN W/ERROR
*
OPNPRFLE EQU      %
         LW,AC3   L('PRN:')         GET FIRST WORD OF FILE NAME
         STW,AC3  WSNAM             SET FIRST WORD OF FILE NAME
         LI,D1    BA(WSNAM)         GET ADDR OF FILE NAME
         PUT,D1   #DOCNM            SET COMMAND STATUS
         LW,D1    SZWSNAME          GET SIZE OF WS FILE NAMES
         PUT,D1   #NCDOCNM          STORE IN COMMAND STATXS
*
         LI,D1    0                 INITIALIZE:
         PUT,D1   #NCACCT              ACCOUNT NUMBER
         PUT,D1   #NCGETPW             PASSWORD
         BAL,SRTN S27OCPY           OPEN PRINT FILE
*
RTNOPNPR EQU      %
         RETURN
*
*
         PAGE
*
* S03RELPR -- RELEASE PRINT FILE(IF PRESENT)
*
*
S03RELPR EQU      %
         SAVRTN
*
         LI,AC1   #IN               OPEN FILE FIRST IN INPUT MODE
         BAL,SRTN S03OPNPR
         LI,AC1   #REL              NOW CLOSE WITH RELEASE
         BAL,SRTN S27CCPY
         RETURN
*
*
* S03SETPR -- RESET PRINT FILE
*
S03SETPR EQU      %
         SAVRTN
*
         LI,AC1   1                 SET EXISTENCE FLAG
         STW,AC1  PRNEXFLG
         LI,AC1   #INOUT            OPEN FILE IN UPDATE MODE
         BAL,SRTN S03OPNPR
         RETURN
*
*
         PAGE
*
* S03CLSPR -- CLOSE PRINT FILE
*
*
S03CLSPR EQU      %
         SAVRTN
*
         LI,AC2   0                 INITIALIZE PR EXISTENCE FLAG
         CI,AC1   #REL              TEST FOR RELEASE PR FILE
         BE       CLSPRFLE             YES, CLOSE PR FILE
         LI,AC2   1                    NO, SET EXISTENCE FLAG ON
*
CLSPRFLE EQU      %
         STW,AC2  PRNEXFLG          STORE PRN EXISTENCE FLAG
         LI,AC1   #SAVE             CLOSE PR FILE WITH SAVE
         BAL,SRTN S27CCPY
         RETURN
*
*
         PAGE
*
*
S03LFMT  EQU      %
         SAVRTN
*
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     RTNLFMT              SET, RETURN
         LI,D1    1                 INITIALIZE LAST FORMAT
         PUT,D1   #LSTFMT
         BAL,SRTN S27TXTLL          FIND WS LAST EY
         CI,AC2   0                 TEST FOR NO LINES
         BE       PRNTFMT              NO LINES, PRINT STATUS
         PUT,AC2  #CLP              SET CLP TO LAST KEY
*
         LI,BUF2  BA(HDRSTA)        GET BUFFER FOR HEADER RECORDS
         LI,AC1   4                 READ CONTROL WORD ONLY
         BAL,SRTN S27RHDR           READ HEADER KEY
         CI,AC1   0                 TEST FOR PRESENT
         BNE      TSTPMODE              YES, TEST FOR MODE
         LI,AC2   -1                   NO, READ PREVIOUS RECORD
*
RDLSTHDR EQU      %
         LI,AC1   4                 READ CONTROL WORD ONLY
         BAL,SRTN S27RHDR           READ PREVIOUS HEADER RECORD
         CW,AC2   L(#ZROKEY)        TEST FOR 0.0
         BLE      PRNTFMT              YES, PRINT STATUS
*
*
         PAGE
*
*
TSTPMODE EQU      %
         JNEZ,AC1 HDR:FMTCDE,SETLAST  TEST FORMAT CODE
         LI,AC2   -2                NONE, READ PREVIOUS
         B        RDLSTHDR          READ PREVIOUS RECORD
*
SETLAST  EQU      %
         PUT,AC1  #LSTFMT           SET LAST FORMAT
*
PRNTFMT  EQU      %
         JGZ,AC1  #LSTFMT,CALLPRNT  GET LAST FORMAT
         LCW,AC1  AC1               CONVERT TO +
         AI,AC1   2                 MESSAGE NUMBER
*
CALLPRNT EQU      %
         BAL,SRTN S29STD            PRINT FORMAT MESSAGE
*
RTNLFMT  EQU      %
         RETURN
*
*
         PAGE
*
* C03CRED -- 'TEXT' CREDIT SWITCH
*
*
C03CRED  EQU      %
         SAVRTN
*
         LI,AC1   0                 SWITCH 'OFF'
         JEZ,D1   (#FLAGS,:K(1)),SCREDFLG  TEST FOR 'ON'
         LI,AC1   1                 YES, TURN 'ON'
*
SCREDFLG EQU      %
         STW,AC1  CREDFLG           STORE CREDIT FLAG
         RETURN
*
*
         PAGE
*
*
* LOCAL VARIABLES
*
3D       CSECT    0                 START OF LOCALS
WLPBASE  EQU      %-1               TEMP STORAGE FOR:
WIDTH    RES      1                     WIDTH
DEPTH    RES      1                     DEPTH
PDEPTH   RES      1                     PDEPTH
WLPSAVE  RES      1                 WLP SAVE WORD
*
WDMSG    MESSAGE  #CR,'WIDTH',(INSWIDTH,4),'   DEPTH',(INSDEPTH,4),;
                      '   CONTINUOUS-FORM DEPTH',(INSCFD,4)
BUFADDR  RES      1                 BUFFER ADDR
COUNT    RES      1                 COUNT FOR OPEN FILES
MAXCOL   RES      1
EXSTFLG  RES      1                 FILE EXISTENCE FLAG
TMPSZ    RES      1                 TEMP SIZE
PRNEXFLG RES      1                 PRINT FILE EXISTENCE FLAG
*
WSNAM    RES      4                 WS FILE NAMES
SZWSNAME RES      1                 SIZE OF WS FILE NAMES
*
TEMPW    DATA     0                 TEMPORARY WIDTH
CREDFLG  DATA     0                 'TEXT' CREDIT FLAG - INITIALLY 'OFF'
*
         USECT    #PLOC
         END
