* 03/23/77 -- 16:00
* MODULE NAME: TIOSM
* NUMBER: 27A
* PURPOSE: PERFORM ALL TERMINAL          I/O SERVICES
*          AND PRELIMINARY LINE EDITING
*
* ENTRY POINTS:
*
 DEF  S27RTNL,S27RTEL,S27READ           *READ LINE FROM TERMINAL
 DEF  S27WTERM,S27PRINT                 *WRITE LINE TO TERMINAL
 DEF  S27INIT,S27END                *INITIALIZE/RESTORE M:UC
 DEF  S27UCTAB,S27TABS              *SET TABS IN DCBS
 DEF  S27SETLP,S27LPRNT,S27EJLP     *LINE PRINTER OUTPUT
         DEF      S27XPRNT,S27XOPEN,S27XCLSE      *XGP FILE OUTPUT
         DEF      FILEKEY           KEY FOR FILE OUTPUT
*
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
         INVDCBTBL
         INVWSSTA
         INVLNSTA
         INVPRSTA
*
         REF      S36PRINT,S36INPUT
         REF      S36M:DRC,S36M:TABS
         REF      S36SCOC,S36RSCOC  SET/RESET COC LINE TABLE
         REF      S36M:INT          SET BREAK CONTROL
         REF      S36OPNLP,S36M:PAGE
         REF      S36CLOSE
         REF      S29STD,S38PSCAN,S38ISCAN
         REF      S04XFIL1,ZRORTNST
         REF      BUFSZ,M:UC
         REF      RECKEY            KEYED FILE KEY
         REF      F:LO              PRINTER OUTPUT DCB
         REF      TOPMRGN,LNCOUNT   TOP MARGIN FOR XGP
         REF      S40PRINT          XGP OUTPUT FORMATTER
         REF      S36OPNVP,S36CLSVP,S36WRVP  F:VP FILE I/O
         REF      S60XBAN           WRITE XGP BANNER
         REF      C02END            END COMMAND PROCESSING
         REF      S36WFKEY          WRITE KEYED FILE
         REF      DRCFPT,TABSFPT
         REF      FILEFLG           FILE OUTPUT FLAG
         REF      BATCHFLG          BATCH MODE FLAG
         REF      3010FLG           3010 TERMINAL FLAG
         REF      3010FWD           3010 FORWARD ONLY FLAG
         REF      M:SI              M:SI DCB
         REF      M:LO              M:LO DCB
         REF      F:LL              F:LL DCB
*
*
         PAGE
*
*
*
         DEF      27AP,27AD
*
27AP     EQU      %
         DATA     X'27A'            MODULE NUMBER
         DATA     X'032377'         DATE
         DATA     X'1600'           TIME
*
*
         TITLE    '** TIOSM(27A) **'
*
* TERMINAL I/O ROUTINES
*
*
*
*
S27RTNL  EQU      %                 READ NEW INPUT LINE
         SAVRTN
         STW,BUF1 FLNSTART          SAVE BUFFER ADDR
*
RDNL     EQU      %
         LI,AC1   0                 INITIALIZE:
         STW,AC1  ATTNFIN              LAST CHAR ATTN FLAG
         STW,AC1  ATTN                 ATTN FLAG
         STW,AC1  ATTNKNT              ATTN COUNT
         STW,AC1  FLNSZ                LINE SIZE
         LW,BUF1  FLNSTART          GET STARTING ADDR FOR READ
         LI,AC2   #MXLNSZ           GET MAX READ SIZE
         BAL,SRTN S27READ           READ LINE
         B        EDITLN            GO EDIT LINE
*
*
         PAGE
*
*
S27RTEL  EQU      %                 EDIT LINE
         SAVRTN
         STW,BUF2 FLNSTART          SAVE BUFFER ADDR
         STW,AC1  FLNSZ             LINE SIZE SO FAR
         LW,X1    FLNSTART          STARTING
         AW,X1    FLNSZ             ADD SIZE
         AI,X1    -1                LAST CHAR
         LB,AC2   0,X1              GET LAST CHAR IN LINE
         CI,AC2   #CR               TEST FOR CR
         BNE      EDIT2               NO, EDIT LINE
         MTW,-1   FLNSZ               YES, REDUCE LINE SIZE BY ONE
         BLEZ     RDNL              ZERO LINE SIZE, NEW LINE
*
EDIT2    EQU      %
         LW,BUF3  FLNSTART          GET BUFFER ADDR FOR WRITE
         LW,AC1   FLNSZ             GET LINE SIZE
         BAL,SRTN S27WTERM          WRITE LINE TO TERM
*
EDIT3    EQU      %
         LW,BUF1  FLNSTART
         AW,BUF1  FLNSZ             CALCULATE NEW START FOR READ
         LI,AC2   #MXLNSZ           GET MAX BUFFER SIZE
         SW,AC2   FLNSZ             CALCULATE WHAT'S LEFT
         BAL,SRTN S27READ           READ REMAINDER OF LINE
*
*
*
         PAGE
*
*
EDITLN   EQU      %
         STW,AC1  LNSZTMP           SAVE READ SIZE
         STW,SR3  ACTTYPE           SAVE ACTIVATION TYPE
         MTW,0    ATTNFIN           TEST LAST CHAR ATTN FLAG
         BEZ      CALCSZ                RESET, CALCULATE NEW LINE SIZE
         MTW,-1   ATTNFIN           RESET LAST CHAR ATTN FLAG
*
         LW,X1    BUF1              FIRST CHAR OF READ
         LB,AC2   0,X1              GET FIRST CHAR
         CI,AC2   #ATTN             TEST FOR ATTN
         BNE      CHKCR                 NO, CHECK FOR CR
*
         MTW,1    ATTNFIN           SET LAST CHAR ATTN FLAG
         MTW,1    FLNSZ             INCREMENT LINE SIZE
         MTW,0    ATTN              TEST ATTN FLAG (FOR STOP CODE)
         BEZ      AT1                   RESET, GO PRINT UL-BKSP
         MTW,-1   ATTN              RESET ATTN FLAG
         MTW,-1   ATTNKNT           DECREMENT ATTN COUNT
         MTW,-1   ATTNFIN           RESET ATTN END FLAG
         MTW,-1   FLNSZ             DECREMENT LINE SIZE
         LI,AC2   #STOP             STOP CODE CHAR
         AI,X1    -1                ADDR OF LAST CHAR
         STB,AC2  0,X1              STORE STOP CODE
         LI,AC1   1                 MESSAGE SIZE=1 (BLANK ONLY)
         LI,BUF1  BA(BLNKMSG)       ADDR OF MESSAGE
         B        ULBS              GO PRINT MESSAGE
*
*
BLNKMSG  DATA,1   #BLANK            ONE BLANK MESSAGE
         BOUND    4
*
*
         PAGE
*
*
CHKCR    EQU      %
         CI,AC2   #CR               TEST FOR CR
         BNE      CHKBKSP               NO, GO CHECK BACKSPACE
         LW,BUF2  FLNSTART          GET LINE ADDR
         LI,AC1   0                 SET SIZE TO ZERO
         LI,AC2   0                 ATTN COUNT = ZERO
         RETURN
*
*
CHKBKSP  EQU      %
         CI,AC2   #BKSP             TEST FOR BKSP EDITING
         BNE      CALCSZ                NO, GO CALCULATE LINE SIZE
*
         STW,X1   FCBKSP            ADDR OF FIRST BKSP
         MTW,-1   FCBKSP            DECREMENT TO INCLUDE ATTN
*
         PAGE
*
*
         LI,AC3   0                 INITIALIZE BKSP COUNT
BKSPLP   EQU      %
         AI,AC3   1                 INCREMENT BKSP COUNT
         MTW,-1   LNSZTMP           DECREMENT NEW READ SIZE
         AI,X1    1                 INCREMENT INPUT LINE POINTER
         CB,AC2   0,X1              TEST NEXT CHAR
         BE       BKSPLP                YES, GET NEXT
*
*
BKSPFIN  EQU      %
         STW,AC3  BKSPKNT           SAVE BKSP COUNT
         STW,X1   LCBKSP            CHAR AFTER LAST BKSP
         LI,D1    #LSTCOL           MAX CARRIER POSITION
         PUT,D1   LN:MXPSTN         STORE IN LINE TABLE
         LW,D1    FCBKSP            CHECK UP TO FIRST BKSP ONLY
         LI,D2    0                 INITIALIZE POSITION FLAG
         STW,D2   PSTNFLG
*
*
         PAGE
*
*
CHKPSTN  EQU      %
         SW,D1    FLNSTART          CALCULATE NUMBER OF CHARS
         PUT,D1   LN:INSZ           STORE IN LINE TABLE
         LI,D1    0
         STW,D1   ATTN              INITIALIZE ATTN FLAG
         STW,D1   ATTNKNT           INITIALIZE ATTN COUNT
         PUT,D1   LN:CPSTN          SET CARRIER POSITION TO ZERO
         LW,X1    FLNSTART          STARTING CHAR
*
PSTNLP   EQU      %
         PUT,X1   LN:INPTR          SAVE INPUT POINTER
         BAL,SRTN S38ISCAN          CHECK CARRIER POSITION
         AI,SR3   WA(RDBTBL)        ADDR OF BRANCH TABLE
         B        *SR3
*
RDBTBL   EQU      %                 BRANCH TABLE
         B        ATTNPSTN            ATTN FOUND
         B        NWPSTN              LAST BACKSPACE POSITION
         B        MXPSTN              NEW CARRIER POSITION
*
*
         PAGE
*
ATTNPSTN EQU      %
         MTW,1    ATTNKNT           INCREMENT ATTN COUNT
         MTW,-1   ATTN              TEST ATTN FLAG
         BGEZ     PSTNLP              SET, CONTINUE SCAN
         MTW,2    ATTN                RESET, NOW SET
         B        PSTNLP            CONTINUE SCAN
*
NWPSTN   EQU      %
         MTW,0    PSTNFLG           TEST POSITION FLAG
         BNEZ     BKSPERR              SET, BKSP ERROR
         MTW,1    PSTNFLG           SET POSITION FLAG
         GET,D1   LN:CPSTN          GET CARRIER POSITION
         SW,D1    BKSPKNT           SUBTRACT BKSP COUNT
         BLEZ     ZROPSTN               ZERO POSITION
         PUT,D1   LN:MXPSTN         STORE IN NEW MAX POSITION
         LW,D1    X1                SCAN UP TO FIRST BKSP
         B        CHKPSTN           FIND NEW POSITION
*
MXPSTN   EQU      %
         AI,X1    -1                CHECK LAST CHAR LEFT
         LB,AC1   0,X1
         CI,AC1   #ATTN             TEST FOR ATTN
         BE       CHKATTN             YES, CHECK FOR DELETE
KPLST    EQU      %                 KEEP LAST CHAR
         AI,X1    1
         B        SHFTLN
*
CHKATTN  EQU      %
         MTW,0    ATTN              TEST ATTN FLAG
         BEZ      KPLST               RESET, KEEP ATTN
         MTW,-1   ATTN                SET, DELETE ATTN
         MTW,-1   ATTNKNT           DECREMENT ATTN COUNT
         PAGE
*
*
SHFTLN   EQU      %
         LW,AC2   X1                GET DEST. ADDR FOR MBS
         LW,AC1   LNSZTMP           GET REMAINING READ SIZE
         BLEZ     DATALOST             ZERO, DATA LOST
         STB,AC1  AC2               COUNT FOR MOVE (# OF CHARS READ)
*
         SW,X1    LCBKSP            CALC DISPLACEMENT FOR SHIFT
         LCW,X1   X1                NEGATE
         LW,X2    L(#SHFTMASK)      MASK TO STORE SHIFT SIZE
         STS,X1   MBSAC2            STORE DISP. IN MBS INST.
         EXU      MBSAC2            EXECUTE MBS INST.
         SW,AC2   FLNSTART          CALCULATE NEW SIZE
         STW,AC2  FLNSZ
         B        CHKLAST
*
*
*
BKSPERR  EQU      %                 BACKSPACE ERROR
*
         LI,AC1   18                'ILLEGAL BACKSPACE' MESSAGE
         BAL,SRTN S29STD
         B        EDIT2
*
ZROPSTN  EQU      %
         LW,X1    FLNSTART          SET LINE START ADDR
         LI,D1    0                 RESET ATTN FLAG AND COUNT
         STW,D1   ATTN
         STW,D1   ATTNKNT
         B        SHFTLN            SHIFT REMAINDER OF LINE
*
*
         PAGE
*
*
CALCSZ   EQU      %
         LW,AC1   LNSZTMP           GET READ SIZE
         AWM,AC1  FLNSZ             ADD TO TOTAL LINE SIZE
*
CHKLAST  EQU      %
         LW,AC1   FLNSZ             GET LINE SIZE
         CI,AC1   #MXLNSZ           TEST FOR MAX SIZE
         BG       DATALOST             YES, DATA LOST
*
         LW,SR3   ACTTYPE           GET ACTIVATION TYPE
         CI,SR3   #ATTN             TEST FOR ATTN
         BE       TSTATTN             YES, SET ATTN FLAGS
         CI,SR3   #CR               TEST FOR CR
         BE       CREND               YES, LINE END
*
DATALOST EQU      %
         LI,AC1   21                'DATA LOST' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         LW,X1    FLNSZ             GET LINE SIZE
         CI,X1    #MXLNSZ           TEST FOR MAX SIZE
         BL       ADDCR                LESS, ADD CR
         LI,X1    #MXLNSZ-1            MORE, SET MAX
*
*
         PAGE
*
*
ADDCR    EQU      %
         STW,X1   FLNSZ             STORE NEW LINE SIZE
         AW,X1    FLNSTART          CALC END OF LINE
         LI,AC1   #CR               GET CR CHAR
         STB,AC1  0,X1              STORE AT END OF LINE
         MTW,1    FLNSZ             INCREMENT LINE SIZE FOR CR
*
         LW,BUF3  FLNSTART          GET START OF LINE
         LW,AC1   FLNSZ                AND SIZE
         BAL,SRTN S27WTERM          WRITE LINE
*
*
         PAGE
*
*
CREND    EQU      %
         LW,BUF2  FLNSTART          SET STARTING ADDR
         LW,AC1   FLNSZ             SET SIZE
         LW,AC2   ATTNKNT           SET ATTN COUNT
         RETURN
*
*
TSTATTN  EQU      %                 TEST FOR ATTN AT END OF LINE
         LI,AC1   2                 ULBS MESSAGE SIZE
         MTW,1    ATTNKNT           INCREMENT ATTN COUNT
         MTW,1    ATTNFIN           SET LAST CHAR ATTN FLAG
         MTW,0    ATTN              ATTN FOUND, TEST ATTN FLAG
         BNEZ     AT2                   SET, THIS IS ATTN NUMBER 2
*
AT1      EQU      %                     RESET, THIS IS FIRST ATTN
         LI,BUF1  BA(ULBSMSG)       UNDERLINE-BKSP RESPONSE
         MTW,1    ATTN              SET ATTN FLAG
         B        ULBS
*
AT2      EQU      %
         LI,BUF1  BA(BSULMSG)       BKSP-UNDERLINE MESSAGE
         MTW,-1   ATTN              RESET ATTN FLAG
*
ULBS     EQU      %
         BAL,SRTN S27PRINT          PRINT UNDERLINE-BKSP
         B        EDIT3             CONTINUE EDIT
*
*
ULBSMSG  DATA,2   #ULBS             UNDERLINE-BKSP MESSAGE
BSULMSG  DATA,2   #BSUL             BKSP-UNDERLINE MESSAGE
*
         PAGE
*
*
S27WTERM EQU      %
         SAVRTN
*
         LI,D1    0                 INITIALIZE:
         STW,D1   ATTNFIN              LASTYDHAR ATTN FLAG
         PUT,D1   PR:LPFLG             LP FLAG(OFF)
         PUT,D1   LN:CPSTN             CARRIER POSIT'ON
         PUT,D1   LN:OUTSZ             OUTPUT LINE SIZE
         LI,D1    -1
         PUT,D1   PR:FMTFLG            FORMATTING FLAG(AS-ENTERED)
*
         LW,D1    BUF3              GET ADDR OF INPUT HUFFER
         PUT,D1   LN:INPTR          STORE IN LINE TABLE
         PUT,AC1  LN:INSZ           STORE INPUT LINE SIZE
         LI,D1    BA(STDPRBUF)      GET ADDR OF PRINT BUFFER
         PUT,D1   LN:OUTPTR         STORE IN LINE TABLE
         BAL,SRTN S38PSCAN          SCAN AND FORMAT LINE
*
*
         PAGE
*
*
         STW,AC1  ATTNKNT           SAVE ATTN COUNT
         STW,AC2  ATTN              AND ATTN FLAG
         CI,AC3   #ATTN             TEST FOR LAST CHAR ATTN
         BNE      PRNTLN               NO, GO TEST FOR STOP
         MTW,1    ATTNFIN              YES, SET ATTN-FIN FLAG
         B        PRNTLN            GO PRINT LINE
*
PRNTLN   EQU      %
         LI,BUF1  BA(STDPRBUF)      GET ADDR OF PRINT BUFFER
         JLEZ,AC1 LN:OUTSZ,RTNWTERM GET OUTPUT LINE SIZE
         BAL,SRTN S27PRINT          GO PRINT LINE
*
RTNWTERM EQU      %
         RETURN
*
*
         PAGE
*
*
S27PRINT EQU      %
         SAVRTN
*
         JEZ,D1   #PRNTFLG,RTNPRNT  TEST PRINT FLAG
         LI,AC3   M:UC              GET ADDR OF UC DCB
         MTB,0    FILEFLG           FILE OUTPUT SET
         BNEZ     NOTTERM           YES
         MTW,0    BATCHFLG          BATCH MODE
         BNEZ     NOTTERM           YES
         STW,AC3  DCBADDR           SAVE ADDR
         LW,D1    BUF1              GET BA OF BUFFER
         SLD,D1   -2                WA IN D1
         SLS,DX1  -30               BYTE DISP IN DX1
*
         CI,AC1   #RDLNSZ           CHECK FOR MAX COC SIZE
         BLE      PRNTLST              OK, PRINT LINE
         LB,X1    3010FLG           GET 3010 OUTPUT FLAG
         STW,X1   3010FWD           SET FORWARD ONLY IF 3010
         AI,AC1   -#RDLNSZ             TOO BIG SUBTRACT
         STW,AC1  NXTBUFSZ          SAVE NEXT WRITE SIZE
         LI,AC1   #RDLNSZ           SIZE FOR FIRST WRITE
*
         BAL,SRTN S36PRINT          WRITE FIRST PART OF LINE
         AI,D1    #RDLNSZ/4         INCREMENT BUFFER ADDR
         LW,AC1   NXTBUFSZ          GET REMAINING SIZE
         LB,X1    3010FLG           GET 3010 OUTPUT FLAG
         STW,X1   3010FWD           SET FORWARD ONLY IF 3010
*
PRNTLST  EQU      %
         BAL,SRTN S36PRINT          PRINT REMAINDER OF LINE
*
RTNPRNT  EQU      %
         RETURN
*
*
NOTTERM  RES      0
         LI,AC3   M:LO              GET M:LO DCB
         MTB,0    BATCHFLG          IS F:LL DCB DESIRED
         BEZ      NOTTERM4          NO
         LI,AC3   F:LL              YES, GET F:LL DCB
NOTTERM4 RES      0
         STW,AC3  DCBADDR           SAVE DCB
         STW,AC1  BUFSZ             SAVE WRITE SIZE
         LW,D1    BUF1              GET BUFFER ADDRESS
         SLD,D1   -2                SET UP WORD ADDR IN D1
         SLS,DX1  -30               SET UP BYTE DISP IN DX1
*
* CHECK FOR OUTPUT ASSIGNED TO FILE
         LW,AC2   *DCBADDR          GET 'ASN' FIELD OF DCB
         AND,AC2  L(X'F')
         CI,AC2   1                 ASN = 1 MEANS FILE
         BNE      DELCR             NOT FILE
         LW,AC2   FILEKEY           GET LAST FILE KEY
         AW,AC2   L(#KEYINCR)       ADD KEY INCREMENT
         STW,AC2  FILEKEY           SAVE
         STW,AC2  RECKEY            SET UP KEY FOR WRITE
*
         BAL,SRTN S36WFKEY          WRITE TO KEYED FILE
         CI,SR3   X'57'             IS STORAGE EXHAUSTED
         BNEZ     RTNPRNT           NO
         LI,AC1   80                SET UP 'FILE OUT SPACE EXHAUSTED' MSG
         BAL,SRTN S29STD            GO WRITE MESSAGE
         LI,AC1   #REL              SET UP TO RELEASE OUTPUT FILE
         BAL,SRTN S04XFIL1          GO EXIT FILE OUTPUT MODE
         B        ZRORTNST          CONTINUE
         B        RTNPRNT
*
* DELETE EMBEDDED CR CHARS FOR LP PRINT
DELCR    RES      0
         LI,X3    #CR               GET A CR CHAR
         LW,X4    BUF1              GET BA OF INPUT BUFFER
         AW,X4    AC1               GET ADDR OF END OF BUFFER
*
* CHECK FOR TRAILING CR'S
DELCR20  RES      0
         AI,X4    -1                DECR BUFFER POINTER
         CB,X3    0,X4              IS CHAR = CR
         BNE      DELCR35           NO
         BDR,AC1  DELCR20           CONTINUE
         B        DELCR50           NO MORE CHARS
DELCR35  RES      0
         LW,X4    BUF1              GET BA OF BUFFER
*
* CHECK FOR LEADING CR'S
DELCR40  RES      0
         CB,X3    0,X4              IS CHAR = CR
         BNE      DELCR50           NO
         AI,DX1   1                 YES, INCR BYTE DISP OF WRITE
         AI,X4    1                 INCR BUFFER POINTER
         BDR,AC1  DELCR40           CONTINUE
*
DELCR50  RES      0
         BAL,SRTN S36PRINT          GO PRINT BUFFER
         LW,AC1   BUFSZ             RESTORE ORIGINAL BUFFER SIZE
         B        RTNPRNT           RETURN
*
         PAGE
*
*
* READ FROM TERMINAL WITH NO EDITING
* USED TO READ 'ATTN-CR' AND 'ATTN-ATTN' RESPONSES
*
S27READ  EQU      %
         SAVRTN
*
         STW,AC2  NXTBUFSZ          SAVE MAX SIZE
         LI,AC3   0
         STW,AC3  LNSZTMP           INITIALIZE READ SIZE
         LI,AC3   #RDLNSZ           STANDARD READ SIZE
         STW,AC3  BUFSZ
         LW,D1    BUF1              INPUT BUFFER ADDR
*
RDBUFLP  EQU      %
         LW,AC3   NXTBUFSZ          GET REMAINING MAX SIZE
         BLEZ     NOBUF             NONE LEFT
         SLD,D1   -2                WORD ADDR OF READ
         SLS,DX1  -30               BYTE DISP OF READ
         AI,AC3   -#RDLNSZ
         STW,AC3  NXTBUFSZ          CALCULATE REMAINING BUFFER SIZE
         BGZ      RDLN              READ LINE IF POSITIVE
*
LSTRD    EQU      %
         AI,AC3   #RDLNSZ           MAX SIZE NEGATIVE OR ZERO
         STW,AC3  BUFSZ             LAST READ SIZE
*
*
         PAGE
*
*
RDLN     EQU      %
         LI,AC3   M:UC              GET DCB ADDR
         MTW,0    BATCHFLG          BATCH/ON-LINE
         BEZ      RDLN20            ON-LINE
         LI,AC3   M:SI              BATCH, USE M:SI DCB
RDLN20   RES      0
         STW,AC3  DCBADDR
         BAL,SRTN S36INPUT
         GET,AC1     *#ARS          GET READ SIZE FROM DCB
         CI,SR3   0                 ANY ERRORS
         BNE      RDLNERR           YES
         MTW,0    BATCHFLG          BATCH MODE
         BLEZ     RDLN27            NO
         LW,X1    BUF1              CALCULATE ADDR OF LAST CHAR
         AW,X1    AC1
*
* DELETE TRAILING BLANKS
RDLN24   RES      0
         AI,X1    -1
         LB,SR3   0,X1              GET LAST CHAR
         CI,SR3   #BLANK            IS LAST CHAR = ' '
         BNE      RDLN26            NO, FINISHED
         BDR,AC1  RDLN24            CONTINUE
RDLN26   RES      0
         AI,AC1   1
RDLN27   RES      0
         AWM,AC1  LNSZTMP           ADD TO LINE SIZE
         LW,D1    BUF1              GET STARTING ADDR
         AW,D1    LNSZTMP           CALCULATE NEXT CHAR ADDR
*
         LW,X1    D1
         AI,X1    -1
         MTW,0    BATCHFLG          BATCH MODE
         BGZ      RDLN30            YES
         LB,SR3   0,X1              GET LAST CHAR OF READ
         CI,SR3   #LF               TEST FOR LINE FEED
         BNE      ATNCRTST            NO, TEST FOR ATTN OR CR
*
RDLN30   RES      0
         LI,SR3   #CR
         STB,SR3  0,X1              REPLACE LF WITH CR
         B        RTNREAD
*
*
RDLNERR  RES      0
         CI,SR3   5                 EOD ENCOUNTERED
         BE       C02END            YES, EXIT
         CI,SR3   6                 OEF ENCOUNTERED
         BE       C02END            YES, EXIT
         CI,SR3   7                 DATA LOST
         BNE      RDLN27            NO
         AI,AC1   -1                YES, DECR SIZE FOR POSSIBLE X'BE'
         LI,SR3   0
         STW,SR3  NXTBUFSZ          FORCE NO BUFFER SPACE LEFT
         B        RDLN27
         B        RDLN27
         PAGE
*
*
ATNCRTST EQU      %
         CI,SR3   #CR               TEST FOR CR
         BE       RTNREAD             YES, RETURN
         CI,SR3   #ATTN             TEST FOR ATTN
         BNE      RDBUFLP           NO, GET NEXT BUFFER
*
RTNREAD  EQU      %
         LW,AC1   LNSZTMP           GET TOTAL READ SIZE
         RETURN
*
NOBUF    EQU      %
         LI,SR3   0                 BUFFER FULL RETURN
         B        RTNREAD
*
*
         PAGE
*
* S27INIT -- INITIALIZE M:UC DCB, ACTIVATION SET, ETC.
*
*
S27INIT  EQU      %
         SAVRTN
*
         BRKCTRL  0                 INITIALIZE BREAK CONTROL
         BAL,SRTN S36M:INT
         LI,AC1   M:UC              GET ADDR OF M:UC
         STW,AC1  DCBADDR           STORE ADDR
         AI,AC1   :EO(DCB:TABS)     ADD WORD OFFSET FOR TABS
         SLS,AC1  2                 CONVERT TO BYTE ADDR
         MOVE,X1  *AC1,BA(SAVUCTABS),16  MOVE UC TABS
*
         GET,D1   *DCB:DRC          GET DRC BIT FROM M:UC
         STW,D1   SAVUCDRC          SAVE DRC BIT
         LI,AC1   DRCFPT            GET ADDR OF M:DRC FPT
         STW,AC1  FPTADDR           SET FPT ADDR
         LI,D1    #DRCONWRD         GET DRC 'ON' WORD
         PUT,D1   *FPT:DRCWRD       STORE IN FPT
         BAL,SRTN S36M:DRC          NOT SET DRC IN M:UC
         BAL,SRTN S36SCOC           SET COC LINE TABLE
*                                      TO EOT ONLY
         RETURN
*
         PAGE
*
* S27END -- RESTORE M:UC TABS AND DRC
*
*
S27END   EQU      %
         SAVRTN
*
         BAL,SRTN S36RSCOC          RESET COC LINE TABLE
         LI,AC1   M:UC              GET ADDR OF M:UC
         STW,AC1  DCBADDR           STORE ADDR
         LI,AC2   TABSFPT           ADDR OF M:TABS FPT
         STW,AC2  FPTADDR           STORE ADDR
*
         AI,AC2   :EO(FPT:TABS)     ADD OFFSET FOR TABS
         SLS,AC2  2                 CONVERT TO BA
         AI,AC2   1                 DISPLACEMENT
         LI,D1    16                16 TABS MAX
         STB,D1   AC2               COUNT FOR MBS
         LI,AC1   BA(SAVUCTABS)     ADDR OF SAVED TABS
         MBS,AC1  0                 MOVE TABS TO FPT
*
         PUT,D1   *FPT:NTABS        STORE NUMBER OF TABS
         BAL,SRTN S36M:TABS         SET TABS IN DCB
*
         LW,D1    SAVUCDRC          GET SAVED DRC BIT
         BNEZ     RTNEND            ALREADY SET, RETURN
         PUT,D1   *FPT:DRCWRD       SET FPT DRC WORD
         BAL,SRTN S36M:DRC          SET DRC IN DCB
*
RTNEND   EQU      %
         RETURN
*
*
         PAGE
*
* S27UCTAB,S27TABS -- SET TABS IN SPECIFIED DCB
*
S27UCTAB EQU      %
         LI,AC3   M:UC              GET ADDR OF M:UC DCB
         STW,AC3  DCBADDR
S27TABS  EQU      %
         SAVRTN
*
         LI,AC2   TABSFPT           GET ADDR OF M:TABS FPT
         STW,AC2  FPTADDR           STORE FPT ADDR
         AI,AC2   :EO(FPT:TABS)     ADD WORD OFFSET FOR TABS
         SLS,AC2  2                 CONVERT TO BYTE ADDR
         AI,AC2   1                 DISP IN WORD
*
         LI,AC1   :ADEO(WS:TABS)    GET WA OF TABS IN WS STATUS
         SLS,AC1  2                 CONVERT TO BA
         JEZ,X1   WS:NTABS,STLSTAB  GET NUMBER OF TABS
         STB,X1   AC2               COUNT FOR MBS
         MBS,AC1  1                 MOVE TABS TO FPT
         CI,X1    WS:MXTABS         TEST FOR MAX TABS
         BGE      SETTABS              YES, GO SET TABS
STLSTAB  EQU      %
         AI,X1    1                 INCREMENT COUNT
         LI,D1    0
         PUT,D1   *FPT:TABS,X1      STORE 0 IN LAST TAB
*
SETTABS  EQU      %
         PUT,X1   *FPT:NTABS        STORE TAB COUNT
         BAL,SRTN S36M:TABS         SET TABS IN DCB
         RETURN
         PAGE
*
* S27EJLP -- EJECT LINE PRINTER PAGE
*
S27EJLP  EQU      %
         SAVRTN
*
         LI,BUF1  BA(PGBUF)         ADDR OF PAGE EJECT
         LI,AC1   2                 BUFFER SIZE
         JNEZ,D1  PR:VFLG,EJXGP     TEST VIDEO FLAG
         BAL,SRTN S27LPRNT          PRINT TO LP
         B        RTNEJLP           RETURN
*
EJXGP    EQU      %
         BAL,SRTN S27XPRNT          PRINT TO XGP
         LI,D1    1                 INITIALIZE LINE COUNT
         STW,D1   LNCOUNT
         LW,D1    TOPMRGN           GET TOP MARGIN LINES
         STW,D1   SKPCOUNT          SAVE COUNT
*
MRGNLP   EQU      %
         MTW,-1   SKPCOUNT          DECR SKIP COUNT
         BLEZ     RTNEJLP           TEST FOR DONE
         LI,BUF1  BA(PGBUF)+1       ADDR FOR LINE SKIP
         LI,AC1   2                 NUMBER OF CHARS
         LI,AC2   2                 SPECIFY XGP OUTPUT
         LI,AC3   1                 FORMATTING CODE (UNF)
         BAL,SRTN S40PRINT          CALL FORMAT ROUTINE
         B        MRGNLP            TEST FOR MORE
*
RTNEJLP  EQU      %
         RETURN
PGBUF    DATA     X'F1404040'         PAGE EJECT BUFFER
SKPBUF   DATA     X'40404040'       SKIP ONE LINE
*
*
* S27LPRNT -- WRITE OUTPUT LINE TO LINE PRINTER
*
S27LPRNT EQU      %
         SAVRTN
*
         LI,AC3   F:LO              SET DCB ADDR
         STW,AC3  DCBADDR
         CI,AC1   132               TEST MAX LP SIZE
         BLE      SETBUFS              NO, SET BUFFERS
         LI,AC1   132                  YES, SET SIZE
*
SETBUFS  EQU      %
         LW,D1    BUF1              GET BUFFER ADDR
         SLD,D1   -2                CONVERT TO WA
         SLS,DX1  -30               SET BYTE DISPLACEMENT
         BAL,SRTN S36PRINT          PRINT LINE
*
         RETURN
*
*
         PAGE
*
* S27SETLP -- SET LP DCB FOR OUTPUT
*
S27SETLP EQU      %
         SAVRTN
*
         LI,AC3   F:LO              SET DCB ADDR
         STW,AC3  DCBADDR
         JNEZ,D1  *DCB:FCD,LPDCBOK  TEST FOR DCB OPEN
         BAL,SRTN S36OPNLP          OPEN LP DCB
         CI,SR3   0                 TEST FOR ERROR
         BNE      RTNSETLP             YES, RETURN
*
         BAL,SRTN S27TABS           SET TABS IN DCB
*
LPDCBOK  EQU      %
         BAL,SRTN S36M:PAGE         EJECT LP PAGE
         LI,SR3   0                 SET NO ERROR RETURN
RTNSETLP EQU      %
         RETURN
*
*
         PAGE
*
* XGP OUTPUT ROUTINES
*        S27XOPEN -- OPEN XGP OUTPUT FILE
*        S27XPRNT -- PRINT XGP OUTPUT LINE
*        S27XCLSE -- CLOSE XGP OUTPUT FILE
*
S27XOPEN EQU      %
         SAVRTN
*
         BAL,SRTN S36OPNVP          GO OPEN F:VP FILE
         BAL,SRTN S60XBAN           WRITE XGP BANNER
         BAL,SRTN S27EJLP           GO TO NEXT PAGE
         RETURN
*
*
S27XPRNT EQU      %
         SAVRTN
*
         BAL,SRTN S36WRVP           GO WRITE F:VP FILE
         RETURN
*
*
S27XCLSE EQU      %
         SAVRTN
*
         BAL,SRTN S36CLSVP          GO CLOSE VP FILE
         RETURN
*
*
         PAGE
*
* LOCAL VARIABLES
*
27AD     CSECT    0                 START OF LOCALS
*
*
MBSAC2   MBS,AC2  0                 SHIFT INSTRUCTION
*
FLNSTART RES      1                 BYTE ADDR OF FIRST INPUT CHAR
FLNSZ    RES      1                 SIZE OF INPUT LINE
ACTTYPE  RES      1                 READ ACTIVATION TYPE
NXTBUFSZ RES      1                 NEXT READ SIZE
LNSZTMP  RES      1                 TEMP READ SIZE
*
ATTN     RES      1                 ATTN FLAG
ATTNFIN  RES      1                 ATTN AT END-OF-LAST-LINE FLAG
ATTNKNT  RES      1                 ATTN CHAR COUNT
*
FCBKSP   RES      1                 FIRST CHAR TO DELETE W/BKSP
LCBKSP   RES      1                 FIRST CHAR AFTER BKSP DELETE
CPSTN    RES      1                 CARRIER POSITION FOR BKSP EDIT
PSTNFLG  RES      1                 POSITION FLAG
BKSPKNT  RES      1                 BKSP COUNT
*
SAVUCDRC RES      1                 SAVE M:UC DRC WORD
SAVUCTABS RES,1   16                SAVE M:UC TAB SETTINGS
*
SKPCOUNT RES      1                 LINE SKIP COUNT
*
FILEKEY  DATA     X'03000000'       KEY ZERO
*
*
         USECT    #PLOC
        END
