*
*   PROCEDURE AND STATIC DATA AREA FOR
*   GENERALIZED TERMINAL HANDLER.
*
*        (SEE GTH0 FOR DYNAMIC DATA)
*
*        (SEE GTHDATA FOR DEFINITION OF DATA, AS
*         WELL AS FOR VARIOUS PROC'S USED HERE)
*
*        THIS MODULE CONTAINS TWO ROUTINES, L:INIT & L:WRITE,
*        PLUS SEVERAL SUPPORTIVE SUBROUTINES FOR THESE TWO.
*
*        L:INIT IS USED TO SET THE TERMINAL TO A STANDARD STATE, SO
*        THAT SUCCESIVE CALLS TO L:WRITE CAN KEEP TRACK OF THINGS
*        VIA SOFT COUNTERS.  L:INIT MAY ALSO BE USED TO SET SOME
*        PARAMETERS (SUCH AS LEFT MARGIN) OR MODES (E.G, VFC OR
*        NO VFC).
*
*        L:WRITE INSPECTS AND FORMATS THE LINE OF OUTPUT, IN ORDER
*        TO REMEMBER FINAL COLUMN AND LINE POSITION.  KNOWING THESE
*        THINGS ALLOWS SOME TRICKY STUFF LIKE BACKWARD PRINTING AND
*        ABSOLUTE TABBING TO VARIOUS SPOTS ON THE PAGE FRAME, THUS
*        SPEEDING UP ACTUAL OUTPUT (USUALLY).
*
         TITLE    '             PROLOGUE'
*
*
GTH1P    CSECT    1                 PROCEDURE
GTH1D    CSECT    1                 STATIC DATA
*
         SYSTEM   BPM               SYSTEM INTERFACE
*
         M:PT     1                 READ-ONLY FPTS
*
         DEF      L:INIT
         DEF      L:WRITE
*
         REF      GTH0              DYNAMIC DATA BASE
*
         TITLE    '             PROCEDURES'
*
*   PROCEDURES
*
*        IN ORDER TO REDUCE THE NUMBER OF EXTERNAL SYMBOLS REQUIRED
*        TO ACCESS THE DYNAMIC DATA IN THE GTH0 MODULE, THE FOLLOWING
*        PROCEDURES DEFINE ALL DATA NAMES IN TERMS OF AN OFFSET FROM
*        THE SINGLE EXTERNAL BASE SYMBOL, 'GTH0'.
*
*        (INCIDENTLY, THROUGH AP C00, THERE IS A BUG THAT WILL PREVENT
*        FURTHER ADDRESSING FUNCTIONS TAKING EFFECT ON THESE SYMBOLS
*        SO DEFINED, SO BE CAREFUL.  META WORKS OKAY, IN ANY CASE.  JEQ)
*
BND      CNAME    0                 PSEUDO 'BOUND' PROC
D        CNAME    1                 PSEUDO 'DATA' PROC
G        CNAME    2                 PSEUDO 'GEN' PROC
R        CNAME    3                 PSEUDO 'RES' PROC
*
         OPEN     I,#2,%%%
%%%      SET      0                 PSEUDO BYTE LOCATION COUNTER
*
         PROC
         DO       NAME>0
LF          EQU   WA(BA(GTH0)+%%%)  OFFSET INTO DYNAMIC DATA BLOCK
         FIN
         GOTO,NAME  #1,#2,#3
#0        BOUND   1                 BOUND
%%%         SET   AF*(%%%//AF)
            GOTO  PEND
#1        BOUND   1                 DATA
%%%         SET   %%%+S:S(NUM(CF)>1,4,CF(2))*S:S(NUM(AF)>1,1,NUM(AF))
            GOTO  PEND
#2        SET     0                 GEN
I           DO    NUM(CF)-1
#2             SET #2+CF(I+1)
             ELSE
#2             SET 32
            FIN
%%%         SET   %%%+#2//8
            GOTO  PEND
#3        BOUND   1                 RES
%%%         SET   %%%+S:S(NUM(CF)>1,4,CF(2))*AF(1)
PEND     PEND
*
         CLOSE    I,#2,%%%
*
*   P U T P
*
*        PROCEDURE TO STORE A BYTE IN THE OUTPUT BUFFER
*
PUTP     CNAME                      PUT PLAIN
*
         OPEN     I
*
         PROC
         BOUND    4
LF       RES      0
I        DO       NUM(AF)
            LV,CHAR AF(I)
            CALL  PUTP
         FIN
         PEND
*
         CLOSE    I
*
         TITLE    '             STATIC DATA'
*
*   STATIC DATA AREA
*
         USECT    GTH1D             STATIC DATA
*
*        EBCDIC TO ASCII CONVERSION TABLE, INDEXED BY EBCDIC
*        CHARACTER VALUE.  (THERE IS SOME FOOLERY GOING ON IN THE FIRST
*        32 POSITIONS, BUT NO TIME TO CLEAN IT UP - JEQ)
*
CONVERT  DATA,8   X'0001020304090607',X'0805150B0C0D0E0F'
         DATA,8   X'10111213140A1617',X'18191A1B1C1D1E1F'
         DATA,16
         DATA,16
         DATA,8   X'2000000000000000',X'0000602E3C282B7C'
         DATA,8   X'2600000000000000',X'000021242A293B7E'
         DATA,8   X'2D2F000000000000',X'00005E2C255F3E3F'
         DATA,8   X'0000000000000000',X'00003A2340273D22'
         DATA,8   X'0061626364656667',X'6869000000000000'
         DATA,8   X'006A6B6C6D6E6F70',X'7172000000000000'
         DATA,8   X'0000737475767778',X'797A000000000000'
         DATA,8   X'005C7B7D5B5D0000',X'0000000000000000'
         DATA,8   X'0041424344454647',X'4849000000000000'
         DATA,8   X'004A4B4C4D4E4F50',X'5152000000000000'
         DATA,8   X'0000535455565758',X'595A000000000000'
         DATA,8   X'3031323334353637',X'3839000000000000'
         BOUND    8
M2TO2    DATA     -2,2              RANGE CHECK
          PAGE
*
*   REGISTER ASSIGNMENTS
*        (NOTE CHAR - PT, R1 - R2 OVERLAP)
*
PRINT    EQU      0                 1 IF PRINTABLE CHAR FOUND, ELSE 0
ACC      EQU      1                 ACCUMULATOR
C        EQU      2                 POINTER TO BUFFER
T        EQU      3                 POINTER TO NEXT TAB
PTR      EQU      4                 POINTER TO OUTBUF
SRTN     EQU      5                 SUBROUTINE RETURN ADDRESS
CHAR     EQU      6                 CHARACTER TO BE PUT IN OUTBUF
PT       EQU      7                 POINTER TO BUF
R1       EQU      6                 EVEN REGISTER OF PAIR
R2       EQU      7                 ODD REGISTER OF PAIR
LPC      EQU      8                 LAST PRINTING CHARACTER
*
         ERROR,0,R2~=(R1|1)  'CHECK STS'
         ERROR,0,T~=(PTR-1)  'CHECK STM'
*
         SYSTEM   GTHDATA           GET EXTERNAL DATA AREA DEFS
*
         USECT    GTH1P             PROCEDURE
*
         TITLE    '                            INITIALIZE'
************************************************
****************   INITIALIZE   ****************
************************************************
*
*   PERFORM INITIALIZATION OR TERMINATION FOR
*   BLOCK OF L:WRITE CALLS.  ALSO, ALLOW
*   SETTING OR RESETTING OF VARIOUS PARAMETERS
*   WITH OR WITHOUT THE INITIALIZATION.
*
*        INPUT:   WORD FOLLOWING BAL IS ADDRESS OF FPT.
*
*        OUTPUT:  PERFORMANCE OF FUNCTION
*
*        CALL:    BAL,5  L:INIT
*                 DATA   FPT
*
*        SUBS:    LIMIT
*                 RESET
*
*        USES:    SRTN
*
*        ASSUME:  THE LINK REGISTER, 5, IS NOT USED FOR INDIRECTION
*                    OF THE FPT OR DCB ADDRESS.
*
*        NOTES:   ONLY THE RESET OPTION CAUSES A DISRUPTION OF
*                    SOMETHING OTHER THAN AN EXPLICITLY SPECIFIED
*                    PARAMETER OR MODE, AND THAT IS CONTAINED
*                    IN THE RESET SUBR, ITSELF.
*
         LOCAL
*
L:INIT   RES      0
         LCI      0
         STM,0    REGTABLE          SAVE ALL REGS
*
*   SET FPT ADDRESS
*
         MTW,0    0,SRTN            TEST FOR INDIRECT FPT ADDRESS
         IF,LZ                      DOIF *
         LW,SRTN  *0,SRTN
         ELS                        PLAIN
         LW,SRTN  0,SRTN
         FI
         STW,SRTN FPTADDR           SAVE FOR LOOKING AT FPT
*
*   SET DCB ADDRESS
*
         LW,SRTN  *FPTADDR          WORD 0 OF FPT
         IF,LZ                      DOIF *
         LW,SRTN  *SRTN
         FI
         AND,SRTN L(FMASK(I%ADR))   CLEAN IT UP JUST FOR FUN
         STW,SRTN FPT               STASH
*
*   PROCESS OPTIONAL PARAMETERS
*
         MTW,+1   FPTADDR           NOTE
*        ------   -------           ----
         LV,PT    1                 INDEX TO PARAMETER
         LW,ACC   *FPTADDR          GET PRESENCE WORD
         IF,FNZ   FMASK(I%P1),ACC   CHECK P1 (PAGSIZE)
         LW,ACC   *FPTADDR,PT       GET PARAMETER
         CALL     INDIRECT          TEST FOR POSSIBLE INDIRECTION
         STW,ACC  PL
         AV,PT    1                 BUMP PARAMETER INDEX
         FI
         LW,ACC   *FPTADDR          GET PRESENCE WORD
         IF,FNZ   FMASK(I%P2),ACC   CHECK P2 (LEFTMAR)
         LW,ACC   *FPTADDR,PT       GET PARAMETER
         CALL     INDIRECT          TEST FOR POSSIBLE INDIRECTION
         STW,ACC  LEFTMAR
         FI
*
*   NOW PROCESS FLAGS, IN SYNC WITH ASSOCIATED SIGNIFICANCE BITS
*
         LW,R1    *FPTADDR          GET FLAG WORD
         SHIFT,R1 LBIT(I%FOR),31    POSTION FOR/FB (f0)
         LH,R2    R1                GET POSITIONED MASKS
         AND,R2   L(1)              GET CURRENT MASK BIT
         STS,R1   FB
         SHIFT,R1 LBIT(I%HT),LBIT(I%FOR) POSITION NOHT/HT (f1)
         LH,R2    R1                GET POSITIONED MASKS
         AND,R2   L(1)              GET CURRENT MASK BIT
         STS,R1   HOR
         SHIFT,R1 LBIT(I%VT),LBIT(I%HT)   POSITION NOVT/VT (f2)
         LH,R2    R1                GET POSITIONED MASKS
         AND,R2   L(1)              GET CURRENT MASK BIT
         STS,R1   VER
         SHIFT,R1 LBIT(I%VFC),LBIT(I%VT) POSITION VFC/NOVFC (f3)
         LH,R2    R1                GET POSITIONED MASKS
         AND,R2   L(1)              GET CURRENT MASK BIT
         STS,R1   VFC
         IF,FNZ   FMASK(I%RESET)**(LBIT(I%VFC)-31),R1  RESET (f4)
         CALL     RESET
         FI
         LCI      0
         LM,0     REGTABLE          RESTORE ALL REGISTERS
         B        1,SRTN            RETURN
*
         TITLE    '                            WRITE'
*******************************************
****************   WRITE   ****************
*******************************************
*
*   WRITE THE INPUT LINE TO THE TERMINAL, SUBJECT TO
*   VARIOUS RESTRAINTS AND CONDITIONS FROM PREVIOUS
*   CALLS.
*
*        INPUT:   WORD FOLLOWING BAL IS ADDRESS OF FPT
*                 POS IS (1-ORIGIN) LINE POSITION FROM LAST CALL
*                 PLFCT IS COUNT OF PENDING LINEFEEDS FLC
*                 PRHEAD IS (0-ORIGIN) PRINT POSITION FLC
*                 NORMAL IS INDICATOR OF WHETHER LAST TEXT WAS
*                    FORCED TO FORWARD PRINT (0), OR WHETEHER
*                    WE DECIDED, BASED ONLY ON POSITIONING (1).
*
*        OUTPUT:  PERFORMANCE OF FUNCTION
*
*        CALL:    BAL,5  L:WRITE
*                 DATA   FPT
*
*        SUBS:    ASIS
*                 BACKWARD
*                 FORWARD
*                 LINEFEED
*                 PUT/PUTP
*                 RESETTM
*                 SETTM
*                 TABLANK
*                 VFCP
*
*        USES:    SRTN
*
*        FLOW:    PROCESSES THE FPT, KEEPING INFO WE CAN USE, AND
*                    MOVE IT INTO OUR DATA AREA FOR LATER CHANGE.
*                 IF THIS MESSAGE GOES ON SAME LINE AS A PREVIOUS
*                    ONE (OR ONES), OR IF IT CONTAINS AN ESCAPE
*                    CHARACTER, JUST WRITE IT, AS IS, TO THE TERMINAL.
*                 OTHERWISE, PRINT IT IN THE DIRECTION WHICH WE CAN
*                    START WITH FASTEST.
*                 CHANGE USER FPT TO POINT TO OUR CONVERTED (OR
*                    JUST TRANSLATED) MESSAGE, AND WRITE IT TO
*                    THE TERMINAL.
*
*        ASSUME:  THE LINK REGISTER, 5, IS NOT USED FOR INDIRECTION
*                    OF THE FPT OR DCB ADDRESS.
*
*        NOTES:   IF EITHER THE BUFFER OR SIZE PARAMETER IS MISSING
*                    FROM THE FPT, WE KICK OUT - SHOULD PROBABLY
*                    GET THEM FROM THE DCB.
*                 NO CHECK IS MADE TO ENSURE THAT DCB IS SAME AS
*                    SPECIFIED IN LAST L:INIT (IF ANY) CALL -
*                    PERHAPS IT SHOULD BE.
*
         LOCAL    %10
*
L:WRITE  RES      0
         LCI      0                 SET UP CONDITION CODE
         STM,0    REGTABLE          STORE REGISTERS IN REGTABLE
*
*   SET FPT ADDRESS
*
         MTW,0    0,SRTN            TEST FOR INDIRECT FPT ADDRESS
         IF,LZ                      DOIF *
         LW,SRTN  *0,SRTN
         ELS                        PLAIN
         LW,SRTN  0,SRTN
         FI
         STW,SRTN FPTADDR           SAVE FOR LOOKING AT FPT
*
*   SET DCB ADDRESS AS 1ST WORD OF M:WRITE FPT
*
         LW,SRTN  *FPTADDR          WORD 0 OF FPT
         IF,LZ                      DOIF *
         LW,SRTN  *SRTN
         FI
         AND,SRTN L(FMASK(I%ADR))   CLEAN IT UP
         OR,SRTN  L(X'11000000')    CLEAN UP ANY INDIRECT ON REG.
         STW,SRTN FPT
*
*   INITIALIZE
*
         LI,PRINT 0
         LI,C     0
         LI,PTR   0
         STW,PRINT FFLAG            RESET FORWARD FLAG
         STW,PRINT FORFLAG          RESET FORFLAG
         STW,PRINT BTD              RESET BYTE DISPLACEMENT TO ZERO
         MTW,0    PRHEAD
         IF,LZ
*
*   LOGIC COULD GET US HERE AFTER BACK-PRINT, BUT MECHANISM
*   WOULD HAVE ACTUALLY STOPPED IT AT ZERO.
*
         STW,PRINT PRHEAD
         FI
*
*   PROCESS OPTIONAL PARAMETERS IN FPT
*
         MTW,+1   FPTADDR           NOTE
*        ------   -------           ----
         LV,PT    1                 INDEX TO PARAMETER
         LW,ACC   *FPTADDR          GET PRESENCE WORD
         IF,FNZ   FMASK(I%P1),ACC   CHECK P1 (ERR)
         AI,PT    1
         FI
         IF,FNZ   FMASK(I%P2),ACC   CHECK P2 (ABN)
         AI,PT    1
         FI
         IF,FNZ   FMASK(I%P3),ACC   CHECK P3 (BUF)
         STW,PT   OFFSET            SAVE FOR CHANGE
         LW,ACC   *FPTADDR,PT       GET PARAMETER
         CALL     INDIRECT          TEST FOR POSSIBLE INDIRECTION
         STW,ACC  BUFFER
         AI,PT    1
         ELS                        NO INPUT BUFFER
         B        DONE              JUST LEAVE
*
         FI
         LW,ACC   *FPTADDR          RESTORE PRESENCE WORD
         IF,FNZ   FMASK(I%P4),ACC   CHECK P4 (SIZE)
         LW,ACC   *FPTADDR,PT       GET PARAMETER
         CALL     INDIRECT          TEST FOR POSSIBLE INDIRECTION
         STW,ACC  LBUFFER
         AI,PT    1
         ELS                        NO SIZE SPECIFICATION
         B        DONE              JUST LEAVE
*
         FI
         LW,ACC   *FPTADDR          RESTORE PRESENCE WORD
         IF,FNZ   FMASK(I%P5),ACC   CHECK P5 (KEY)
         AI,PT    1
         FI
         IF,FNZ   FMASK(I%P6),ACC   CHECK P6 (BTD)
         STB,PT   OFFSET            SAVE FOR CHANGE
         LW,ACC   *FPTADDR,PT       GET PARAMETER
         CALL     INDIRECT          TEST FOR POSSIBLE INDIRECTION
         STW,ACC  BTD
         STW,ACC  C
         AI,PT    1
         FI
         LW,ACC   *FPTADDR          RESTORE PRESENCE WORD
         IF,FNZ   FMASK(I%P7),ACC   CHECK P7 (ECB)
         AI,PT    1
         FI
         IF,FNZ   FMASK(I%P8),ACC   CHECK P8 (BLOCK)
         AI,PT    1
         FI
         IF,FNZ   FMASK(I%FOR),ACC  CHECK f0 (FORWARD)
         MTW,+1   FORFLAG           SET FORWARD-ONLY FLAG
         FI
*
*   NOW THAT FPT LENGTH IS KNOWN, MOVE IT INTO OUR DATA
*   AREA FOR FURTHER PROCESSING.
*
         AND,ACC  L(FIMASK(I%FOR))  SCRUB 'OUR' BIT FROM FPT
         STW,ACC  FPT+1
         AI,PT    -1                LENGTH OF FPT - 1
%10      RES      0
         LW,ACC   *FPTADDR,PT
         STW,ACC  FPT+1,PT          MOVE ALL PARAMETER WORDS
         BDR,PT   %10
*
         LI,CHAR  0
         LI,PT    0
         MTW,0    VFC               IN VFC ON?
         IF,NZ
         CALL VFCP                  YES SO DO VFC
         AI,C     1
         FI
         MTW,0    FORFLAG           IS ASIS ON?
         BEZ      TABX              NO,SO CONTINUE
         MTW,0    NORMAL            IS NORMAL ON?
         IF,EZ                      CANNOT DO FORMATTING
         CALL     ASIS              JUST DUMP TO TERMINAL
         ELS
TABX     CALL TABLANK               EXPAND TABS INTO BLANKS
*
*   SEE IF WE CAN USE THE FORMATTED IMAGE
*
         LW,ACC   FFLAG             ACCFFLAG
         IF,NZ                      CANNOT DO FORMATTING
         CALL     ASIS              JUST DUMP TO TERMINAL
         ELS
         LI,ACC   1                 DOING NORMAL F/B PRINTING
         EOR,ACC  FORFLAG           REVERSE SENSE OF 'FORWARD'
         STW,ACC  NORMAL            SO SET NORMAL FLAG TO ONE
         IF,NE    0,PRINT           DOIF ANYTHING TO PRINT
*
*   DECIDE WHETHER TO PRINT THE FORMATTED VERSION FORWARD OR BACKWARD
*
         STW,PT   LBUFFER           LENGTH OF BUFFERPTR(LENGTH OF BUF)
*
*        FB = 0 MEANS NORMAL F/B PRINT; NORMAL IS REVERSED FORFLAG.
*        THUS WE CAN MAKE OUR OWN DECISION IFF FB = 0 AND NORMAL = 1.
*
         LW,ACC   FB                LOOK AT FORWARD/BACKWARD FLAG
         SW,ACC   NORMAL            BOTH IT & NORMAL MUST BE ON
         IF,GEZ                     YES, ITS OFF SO DO ONLY FORWARD PRINTING
         CALL     FORWARD
         ELS
*
*        IF PRHEAD IS TO THE RIGHT OF THE LAST PRINTING CHARACTER, THEN
*        ALWAYS PRINT BACKWARD.  IF TO THE LEFT OF THE FIRST PRINTING,
*        THEN ALWAYS PRINT FORWARD.  IF IN BETWEEN (COUNT IS <= CR, BY
*        THE WAY), THEN FIGURE THE SHORTEST DISTANCE TO AN END POINT,
*        AND PRINT IN THE APPROPRIATE DIRECTION FROM THAT END POINT.
*
         LW,ACC   PRHEAD
         CW,ACC   LPC
         IF,GE                      TO THE RIGHT OF LINE
         CALL     BACKWARD
         ELS
         SW,ACC   COUNT
         IF,LEZ                     TO THE LEFT OF THE LINE
         CALL     FORWARD
         ELS
         LW,CHAR  LPC
         SW,CHAR  PRHEAD            (CHAR = LPC - PRHEAD)
         CW,CHAR  ACC               (ACC = PRHEAD - COUNT)
         IF,GE                      SHORTER TO TAB LEFT; PRINT FORWARD.
         CALL     FORWARD           PRINT  FORWARD
         ELS
         CALL     BACKWARD          PRINT BACKWARD
         FI
         FI
         FI
         FI
         ELS
         LW,ACC   VER               NO, SO GO LOOK AT VER
         IF,EZ                      NO, SO JUST PRINT A BLANK LINE
         MTW,1    PLFCT             INCREMENT LINEFEED COUNTER
         B        DONE              GO EXIT
*
         FI
         PUTP     LF#               PUT LINEFEED IN OUTBUF
         FI
         PUTP     SYN#              ADD SYNC TO OUTBUF
         FI
         FI
*
*   CHANGE USER FPT TO USE OUR CONVERTED RECORD FOR OUTPUT
*
         LW,PT    OFFSET            DISPLACEMENT TO BUF & SIZE
         LI,T     OUTBUF            BUF
         LCI      2
         STM,T    FPT+1,PT          STORE NEW BUF AND SIZE (IN PTR)
         LB,PT    PT                GET FLAG/DISPLACEMENT TO BTD
         IF,NZ                      DOIF BTD SPECIFIED
         LI,ACC   0
         STW,ACC  FPT+1,PT          ZAP IT, OURS IS ZERO.
         FI
*
*   FINALLY, WRITE THE LINE OUT
*
         CALL     SETTM             SET TRANSPARENT MODE
         M:WRITE,E  FPT
         CALL     RESETTM           RESTORE DCB STATE TO ORIGINAL
DONE     RES      0
         LCI      0
         LM,0     REGTABLE          RESTORE REGISTERS
         B        1,SRTN            RETURN PAST CALL
*
         TITLE    '                            ASIS'
******************************************
****************   ASIS   ****************
******************************************
*
*   TRANSFER USER BUFFER TO OUTPUT BUFFER WITH NO CONVERSION
*
*        INPUT:   BTD IS DISPLACEMENT IN USER BUFFER
*                 BUFFER IS ADDRESS OF USER BUFFER
*                 LBUFFER IS SIZE OF USER BUFFER
*                 PLFCT IS PENDING LINEFEED COUNT
*
*        OUTPUT:  USER BUFFER CONTENTS TRANFERRED UNCHANGED TO OUTBUF
*                 PLFCT IS 1 IF LINE ENDS WITH CR AND/OR LF
*                 NORMAL IS SAME AS PLFCT
*                 PRHEAD IS 0 (WE PUNTED)
*                 PTR IS LENGTH IN OUTBUF
*
*        SUBS:    LINEFEED
*                 PUT
*
*        USES:    ACC - C - SRTN - CHAR
*                 SAVE
*
         LOCAL    %10
*
ASIS     RES      0
         STW,SRTN SAVE              SAVE RETURN
         LI,PTR   0
         LW,ACC   PLFCT             PUT LINEFEED COUNT IN ACC
         IF,GZ                      IF ITS <= 0 THEN CONTINUE
         CALL LINEFEED              PURG STORED LINEFEEDS
         FI
         LW,C     BTD               SET BUFFER POINTER TO BYTE DISP
         AWM,C    LBUFFER           ADD BYTE DISP. TO LENGTH TO
%10      RES      0
         LB,CHAR  *BUFFER,C         NEXT BUFFER CHARACTER IN CHAR
         CALL     PUT               ADD CHAR TO OUTBUF
         AI,C     1                 C C+1
         CW,C     LBUFFER           IS C=LENGTH OF BUFFER
         BL       %10               NO, GO BACK FOR NEXT CHARACTER
*
*   TRANSFER DONE.  IF LINE TERMINATED WITH CARRIAGE RETURN, LINE FEED,
*   OR SOME COMBINATION OF THE TWO, ASSUME THAT THIS FINISHES UP TEXT
*   ON THIS LINE.  OTHERWISE, ASSUME THAT MORE IS YET TO COME ON THIS
*   LINE, AND JUST REMAIN READY TO SHOVEL IT OUT TO THE TERMINAL.
*
         AI,C     -1                SET TO LOOK AT 2ND TO LAST CHAR
         LB,CHAR  *BUFFER,C         GET PENTULTIMATE CHARACTER
         IF,EQ    LF,CHAR           IS LAST CHAR A LINEFEED?
         AI,-1    PTR               LAST CHAR IS A LF SO REMOVE
         AI,C     -1
         LI,CHAR  CR                CHAR GETS CARRIAGE RETURN
         CB,CHAR  *BUFFER,C         IS SECOND TO LAST A CR?
         IF,NE                      YES, SO NO NEED TO ADD CR
         CALL     PUT               NO, SO ADD CR
         FI
         LV,ACC   1                 FLAG FOR END OF AS-IS LINE
         ELSF,EQ  CR,CHAR           IS LAST CHARACTER A CR?
         AI,C     -1
         LB,ACC   *BUFFER,C         YES, SO ACC GETS 2ND TO LAST INPUT
         IF,EQ    LF,ACC            IS SECOND TO LAST A LF?
         AI,PTR   -2                GET RID OF LF AND CR, ADD CR
         CALL     PUT               ADD CARRIAGE RETURN
         FI
         LV,ACC   1                 FLAG FOR END OF AS-IS LINE
         ELS                        LAST CHAR NOT CR OR LF
         LV,ACC   0                 FLAG FOR YET MORE AS-IS (POSSIBLY)
         FI
         AWM,ACC  PLFCT             INCREMENT (MAYBE)
         STW,ACC  NORMAL            SAVE TERMINAL FLAG
         LI,ACC   0
         STW,ACC  PRHEAD            RESET
         B        *SAVE             RETURN
*
         TITLE    '                            BACKWARD'
**********************************************
****************   BACKWARD   ****************
**********************************************
*
*   TRANSFER EXPANDED TAB BUFFER TO OUTPUT BUFFER IN A BACKWARD-PRINTING
*   SEQUENCE.
*
*        INPUT:   BUF CONTAINS THE FORMATTED PRINT IMAGE (NO EMBEDDED
*                    TABS)
*                 HOR IS 0 IF ABS HORIZONTAL TABBING ALLOWED (ELSE 1)
*                 LBUFFER IS THE NUMBER OF CHARACTERS IN BUF
*                 LPC (FROM TABLANK) IS INDEX TO LAST PRINTING CHAR
*                 PRHEAD IS (0-ORIGIN) POSTION FROM END OF LAST WRITE
*                 VER IS 0 IF ABS VERTICAL TABBING ALLOWED (ELSE 1)
*
*        OUTPUT:  BUF CONTENTS TRANSFERRED TO OUTBUF
*                 PLFCT BUMPED
*                 POS BUMPED IF VER=1
*                 PRHEAD UPDATED TO HEAD OF THIS LINE
*                 PTR IS LENGTH IN OUTBUF
*
*        SUBS:    HORTAB
*                 LINEFEED
*                 PUT/PUTP
*
*        USES:    ACC - SRTN - CHAR - PT
*                 SAVE
*
         LOCAL    %10,%20
*
BACKWARD RES      0
         STW,SRTN SAVE
         LI,PTR   0
         PUTP     ESC#,6#           FORCE BACKWARD PRINT
*
*   GET TO THE RIGHT SPOT TO START PRINTING
*
         LW,ACC   PRHEAD            FIRST PRINTING POSITION
         SW,ACC   LPC               MUNGE TO FIT HORTAB'S INPUT
         STW,LPC  PRHEAD            IS NEW (STARTING) POSITION
         CALL     HORTAB
*******START ARRANGING OUTPUT BUFFER***********
         LW,PT    LBUFFER
         AI,PT    -1
%10      RES      0
         IF,GE    0,PT              PT<0
         LB,CHAR  BUF,PT            NO, SO LOAD CHAR WITH THE NEXT CHARACTER
         IF,NE    LF,CHAR           DOIF OTHER THAN LINEFEED
         CALL     LINEFEED          CHECK PENDING LINEFEEDS
         LB,CHAR  BUF,PT            RESTORE CHARACTER
         MTW,0    HOR               IS HORIZONTAL ABS TABBING ALLOWED?
         IF,EZ                      DOIF IT IS
         CI,CHAR  SP                IS NEXT CHAR A SPACE?
         BE       BSPACES           YES, SO TRY TO TAB HORIZONTALLY
         CI,CHAR  BS                IS NEXT CHAR A BACKSPACE?
         BE       BSPACES           YES, SO TRY TO TAB HORIZONTALLY
*
         FI
         AI,PT    -1                PTPT+1...INCREMENT OUTPUT POINTER
         MTW,-1   PRHEAD            PRHEADPRHEAD+1
         CALL     PUT               ADD NEXT CHAR TO OUTPUT BUFFER
         B        %10               DO IT AGAIN
*
         FI
         MTW,0    VER               IS ABSOLUTE VER. TABBING ON?
         IF,EZ                      DOIF VHT ALLOWED
         MTW,1    PLFCT             YES,SO INCREMENT LINEFEED COUNTER
         ELS                        VHT NOT ALLOWED
         PUTP     LF#               PUT LINEFEED
         MTW,1    POS               LINEFEED    INCREASE POSITION
         LI,ACC   0
         STW,ACC  PLFCT             PLFCT  0
         FI
         AI,PT    -1                INCREMENT BUF POINTER
         B        %10               GO BACK FOR NEXT CHAR
********DONE ARRANGING BUFFER*******
****START SPACE ROUTINE***
BSPACES  RES      0
         LI,ACC   0
%20      RES      0
         LB,CHAR  BUF,PT            ACCNEXT CHAR
         IF,EQ    SP,CHAR           DOIF BLANK
         AI,ACC   -1
         ELSF,EQ  BS,CHAR           ORIF BACKSPACE
         AI,ACC   1
         ELS                        ADVANCED TO A NON-SPACE TYPE THING
*
*   HERE TO PROCESS RUN OF SPACES OR BACKSPACES
*
         AWM,ACC   PRHEAD           UPDATE TO NEW PRINT POSITION
         LCW,ACC  ACC               MUNGE FOR HORTAB INPUT
         CALL     HORTAB            PROCESS RUN OF SPACE-TYPE THINGS
         B        %10
*
         FI
         AI,PT    -1                FINISH UP SPACE TYPE THING
         BGE      %20               MORE TO GO
*
         FI
         MTW,1    PLFCT             INCREASE LF COUNT
         B        *SAVE             RETURN TO MAIN PROGRAM
*
         TITLE    '                            FORWARD'
*********************************************
****************   FORWARD   ****************
*********************************************
*
*   TRANSFER EXPANDED TAB BUFFER TO OUTPUT BUFFER IN A FORWARD-PRINTING
*   SEQUENCE.
*
*        INPUT:   BUF CONTAINS THE FORMATTED PRINT IMAGE (NO EMBEDDED
*                    TABS)
*                 COUNT (FROM TABLANK) IS INDEX TO 1ST PRINTING CHAR
*                 HOR IS 0 IF ABS HORIZONTAL TABBING ALLOWED (ELSE 1)
*                 LBUFFER IS THE NUMBER OF CHARACTERS IN BUF
*                 NORMAL IS 1 IF A LINEFEED ASSUMED AFTER LINE (ELSE 0)
*                 PRHEAD IS (0-ORIGIN) POSTION FROM END OF LAST WRITE
*                 VER IS 0 IF ABS VERTICAL TABBING ALLOWED (ELSE 1)
*
*        OUTPUT:  BUF CONTENTS TRANSFERRED TO OUTBUF
*                 PLFCT BUMPED IF NORMAL=1 AND VER=0
*                 POS BUMPED IF VER=1
*                 PRHEAD UPDATED TO END OF THIS LINE
*                 PTR IS LENGTH IN OUTBUF
*
*        SUBS:    HORTAB
*                 LINEFEED
*                 PUT/PUTP
*
*        USES:    ACC - SRTN - CHAR - PT
*                 SAVE
*
         LOCAL    %10,%20
*
FORWARD  RES      0
         STW,SRTN SAVE              SAVE RETURN ADDRESS
         LI,PTR    0                OUTPUT BUFFER POINTER0
**SEND "ESC 5" TO INITIATE FORWARD ONLY PRINTING***
         PUTP     ESC#,5#           FORCE FORWARD PRINT
*
*   GET TO THE RIGHT SPOT TO START PRINTING
*
         LW,ACC   COUNT             FIRST PRINTING POSITION
         SW,ACC   PRHEAD            MUNGE TO FIT HORTAB'S INPUT
         AWM,ACC  PRHEAD            IS NEW (STARTING) POSITION
         CALL     HORTAB
*******START ARRANGING OUTPUT BUFFER***********
         LW,PT    PRHEAD            BUF POINTERFIRST PRINTABLE
%10      RES      0
         CW,PT    LBUFFER           PT>LENGTH OF BUF?
         IF,GE                      YES, THUS WE ARE DONE
         LW,ACC   NORMAL            REGULAR STUFF GETS AUTO LF
         AWM,ACC  PLFCT
         B        *SAVE             RETURN TO MAIN PROGRAM
*
         FI
         LB,CHAR  BUF,PT            NO, SO LOAD CHAR WITH THE NEXT CHARACTER
         IF,NE    LF,CHAR           DOIF OTHER THAN LINEFEED
         CALL     LINEFEED          CHECK PENDING LINEFEEDS
         LB,CHAR  BUF,PT            RESTORE CHARACTER
         MTW,0    HOR               IS HORIZONTAL ABS TABBING ALLOWED?
         IF,EZ                      DOIF IT IS
         CI,CHAR  SP                IS NEXT CHAR A SPACE?
         BE       SPACES            YES , SO TRY TO ABSOLUTE HOR TAB
         CI,CHAR  BS                IS NEXT CHAR A BACKSPACE?
         BE       SPACES            YES, SO TRY TO ABSOLUTE HOR TAB
*
         FI
         AI,PT    1                 PTPT+1...INCREMENT OUTPUT POINTER
         MTW,1    PRHEAD            PRHEADPRHEAD+1
         CALL     PUT               ADD NEXT CHAR TO OUTPUT BUFFER
         B        %10               DO IT AGAIN
*
         FI
         MTW,0    VER               IS ABSOLUTE VER. TABBING ON?
         IF,EZ                      DOIF VHT ALLOWED
         MTW,1    PLFCT             YES,SO INCREMENT LINEFEED COUNTER
         ELS                        VHT NOT ALLOWED
         PUTP     LF#               PUT LINEFEED
         MTW,1    POS               LINEFEED    INCREASE POSITION
         LI,ACC   0
         STW,ACC  PLFCT             PLFCT  0
         FI
         AI,PT    1                 INCREMENT BUF POINTER
         B        %10               GO BACK FOR NEXT CHAR
********DONE ARRANGING BUFFER*******
*
****START SPACE ROUTINE***
SPACES   RES      0
         LI,ACC   0
%20      RES      0
         LB,CHAR  BUF,PT            ACCNEXT CHAR
         IF,EQ    SP,CHAR           DOIF BLANK
         AI,ACC   1
         ELSF,EQ  BS,CHAR           ORIF BACKSPACE
         AI,ACC   -1
         ELS                        ADVANCED TO A NON-SPACE TYPE THING
         B        AHT               GO TO PROCESS ACCUMULATED COUNT
         FI
         AI,PT    1                 FINISH UP SPACE TYPE THING
         CW,PT    LBUFFER
         BLE      %20               MORE TO GO
*
*   HERE TO PROCESS RUN OF SPACES OR BACKSPACES
*
AHT      RES      0
         AWM,ACC   PRHEAD           UPDATE TO NEW PRINT POSITION
         CALL     HORTAB            PROCESS RUN OF SPACE-TYPE THINGS
         B        %10
*
         TITLE    '                            FIND TAB'
**********************************************
****************   FIND TAB   ****************
**********************************************
*
*   FIND THE NEXT USUABLE TAB STOP
*   IN THE M:UC DCB.
*
*        INPUT:   LPC IS LAST INTERESTING CHARACTER POSITION. IT IS NOT
*                    YET BUMPED UP TO THE TAB CHARACTER FOR WHICH WE ARE
*                    FINDING A STOP. MOREOVER, IT IS 0-ORIGIN, AND THE
*                    DCB TAB LIST IS 1-ORIGIN.
*
*        OUTPUT:  T IS NEW (TABBED) CARRIAGE POSITION, USING
*                    1-ORIGIN INDEXING.
*                 LPC IS UNCHANGED FROM ENTRY VALUE.
*
*        USES:    T - SRTN
*
         LOCAL    %10
*
FTAB     RES      0
         LI,T     -16
         AI,LPC   2                 SET TO TRUE POSITION OF TAB CHAR
%10      RES      0
         CB,LPC   M:UC+19,T         LPC  GREATER THAN OR EQUAL TO A TAB?
         IF,L                       YES, SO GO FILL IN TABS
         LB,T     M:UC+19,T         SET T EQUAL TO NEXT TAB
         AI,LPC   -2                RESET LPC
         EXIT                       RETURN
*
         FI
         BIR,T    %10               MOVE TO NEXT OF 16 TAB STOPS
*
*   NO TAB FOUND, SO THIS TAB CHARACTER IS ASSUMED TO REPRESENT
*   A SPACE.  THUS T IS OLD VALUE OF LPC PLUS 1 (FOR TAB CHAR) PLUS
*   1 (FOR ORIGIN CONVERSION), BUT LPC WAS ALREADY BUMPED BY 2.....
*
         LW,T     LPC               T GETS LPC
         AI,LPC   -2                RESET LPC
         EXIT                       RETURN
*
         TITLE    '                            HORTAB'
********************************************
****************   HORTAB   ****************
********************************************
*
*   SIMULATE A RUN OF BLANKS AND/OR BACKSPACES IN THE BEST
*   MANNER ALLOWED.
*
*        INPUT:   ACC IS COUNT (+/-) OF POSIIONS TO MOVE, WITH
*                    (+) MEANING TO THE RIGHT.
*                 PRHEAD IS CURRENT (0-ORIGIN) POSITION OF PRINTER
*                    MECHANISM.
*
*        OUTPUT:  THE APPROPRIATE ABS HORIZONTAL TAB OR RUN OF
*                    (BACK)SPACES IS PLACED IN THE OUTPUT BUFFER.
*                 PRHEAD IS UPDATED TO NEW (TO BE) POSITION
*
*        SUBS:    LIMIT
*                 PUT/PUTP
*
*        USES:    ACC - SRTN - CHAR
*                 SAVE1
*
         LOCAL    %10
*
HORTAB   RES      0
         CI,ACC   0
         EXIT,EQ                    JUST GET OUT IF NOTHING TO DO
*
         STW,SRTN SAVE1             SAVE RETURN
         MTW,+0   HOR
         IF,EZ                      DOIF ABS HOR TABBING ALLOWED
         CLM,ACC  M2TO2             IS THERE A LARGE ENOUGH COUNT?
         THEF,OL                    DOIF -2 > ACC > 2
         PUTP     ESC#,HT#          1ST OF 3-CHAR CODE SEQ.
         LW,CHAR  PRHEAD
         AW,CHAR  LEFTMAR           BIAS BY LEFT MARGIN
         AI,CHAR  1                 BUMP FOR TERMINAL INDEXING
         CALL     LIMIT             LIMIT CHECK
         CALL     PUTP
         ELS
*
*   HERE IF WE CANNOT USE ABS HOR TABBING, OR IF IT AIN'T WORTH IT
*
         IF,G     0,ACC             PRESET SPACE OR BACKSPACE
         LV,CHAR  SP#               BLANK
         ELS
         LV,CHAR  BS#
         LCW,ACC  ACC               GET POSITIVE COUNT FOR LOOP
         FI
%10      RES      0
         CALL     PUTP
         BDR,ACC  %10
*
         FI
         B        *SAVE1            RETURN
*
         TITLE    '                            INDIRECT'
**********************************************
****************   INDIRECT   ****************
**********************************************
*
*   TEST FOR INDIRECTION, AND FETCH INDIRECT VALUE,
*   NOTING IF INDIRECTION IS ON A REGISTER.
*
*        INPUT:   ACC IS ADDRESS
*                 REGTABLE IS COPY OF ORIGINAL REGISTER BLOCK
*                 CONDITION CODES UNCHANGED FROM LOAD
*
*        OUTPUT:  ACC IS CONTENTS OF ADDRESSED CELL, OR
*                    IS UNCHANGED IF NOT INDIRECT.
*
*        USES:    ACC - SRTN
*
         LOCAL
*
INDIRECT RES      0
         IF,LZ
         AND,ACC  L(FMASK(I%ADR))   SCRUB FOR TEST
         IF,LE    15,ACC            SEE IF REGISTER
         AI,ACC   REGTABLE
         FI
         LW,ACC   0,ACC
         FI
         EXIT                       RETURN
*
         TITLE    '                            LIMIT'
*******************************************
****************   LIMIT   ****************
*******************************************
*
*   ENSURE THAT THE INPUT VALUE IS IN THE RANGE
*   PERMITTED BY THE TERMINAL FOR AN ASCII COUNT BYTE.
*
*        INPUT:   CHAR IS VALUE
*
*        OUTPUT:  CHAR FORCED TO NEAREST LIMIT IF OUT OF RANGE
*
*        USES:    SRTN - CHAR
*
         LOCAL
*
LIMIT    RES      0
         IF,L     LOVAL,CHAR
         LV,CHAR  LOVAL             FORCE TO LOWEST LEGAL VALUE
         ELSF,G   HIVAL,CHAR
         LV,CHAR  HIVAL             FORCE TO HIGHEST LEGAL VALUE
         FI
         EXIT                       RETURN
*
         TITLE    '                            LINEFEED'
**********************************************
****************   LINEFEED   ****************
**********************************************
*
*   OUTPUT ACCUMULATED LINEFEEDS AS AN ABSOLUTE VERTICAL TAB.
*   IF THE COUNT WOULD TAKE US PAST A PAGE, JUST CUT OFF
*   AT THE PAGE BOUNDARY.
*
*        INPUT:   PLFCT IS LINFEED COUNT
*                 POS IS (1-ORIGIN) LINE NUMBER
*
*        OUTPUT:  PERFORMANCE OF FUNCTION
*                    EITHER AN ABSOLUTE VERTICAL TAB OR A SUFFICIENT
*                    NUMBER OF LINEFEED CHARACTERS HAVE BEEN MOVED
*                    TO THE HEAD OF THE OUTPUT BUFFER TO GET US DOWN
*                    TO THE RIGHT PLACE ONCE A WRITE IS PERFORMED.
*                 POS IS UPDATED TO REFLECT NEW POSITION
*
*        SUBS:    LIMIT
*                 PUTP
*
*        USES:    ACC - SRTN - CHAR
*                 SAVE1
*
         LOCAL    %10
*
LINEFEED RES      0
         LW,ACC   PLFCT
         EXIT,EZ                    JUST KICK OUT IF NO LINEFEEDS
*
         STW,SRTN SAVE1             STORE RETURN ADDERESS
         AW,ACC   POS
         CW,ACC   PL
         IF,LE                      DOIF WOULD NOT CROSS PAGE BOUND
         LW,CHAR  PLFCT             RESTORE COUNT
         MTW,0    VER               IS ABS VERTICAL TABBING ALLOWED
         IF,EZ                      DOIF IT IS
         THEF,G   2,CHAR            DOIF MORE THAN TWO LINEFEEDS
         PUTP     ESC#,VT#          1ST OF 3-CHARACTER SEQUENCE
         LW,CHAR  ACC               SAVED (NEW) LINE POSITION
         CALL     LIMIT             LIMIT CHECK
         CALL     PUTP              PUT IN LINE NUMBER
         STW,CHAR POS               STORE NEW PAGE POSITION
         ELS
%10      RES      0
         PUTP     LF#               PUT LINEFEED IN OUTPUT BUFFER
         MTW,1    POS               INCREASE PAGE POSITION
         MTW,-1   PLFCT             DECREASE LF COUNT
         BNEZ     %10               IF NONZERO ISSUE ANOTHER LINEFEED
*
         FI
         ELS                        WOULD CROSS PAGE BOUNDARY
         PUTP     FF#               TOP-OF-FORM
         LI,ACC   1
         STW,ACC  POS               FIRST LINE
         FI
         LI,ACC   0
         STW,ACC  PLFCT             PLFCT := 0
         B        *SAVE1            RETURN
*
         TITLE    '                            PUT/PUTP'
**********************************************
****************   PUT/PUTP   ****************
**********************************************
*
*   ADD A CHAR TO OUTPUT BUFFER
*
*        INPUT:   CHAR IS EBCDIC CHARACTER (PUT) OR WHATEVER (PUTP)
*                 PTR IS NEXT AVAILABLE POSITION IN OUTPUT BUFFER
*
*        OUTPUT:  ASCII CHARACTER (PUT) OR WHATEVER (PUTP) STORED
*                    IN OUTPUT BUFFER.
*                 PTR ADVANCED TO NEXT POSITION
*
*        USES:    SRTN - CHAR(PUT)
*
PUT      RES      0                 PUT WITH CONVERSION
         LB,CHAR  CONVERT,CHAR      CONVERT CHAR TO ANSCII
PUTP     RES      0                 PUT PLAIN (NO CONVERSION)
         STB,CHAR OUTBUF,PTR        STORE CHARACTER IN OUTPUT BUFFER****
         AI,PTR   1                 PTRPTR+1
         EXIT                       RETURN
*
         TITLE    '                            RESET'
*******************************************
****************   RESET   ****************
*******************************************
*
*   FINISH ANY PENDING ACTIVITY ON PREVIOUS WRITE CALLS.
*   SET SOFT INDICATORS TO TOP-OF-PAGE, AND READY TO GO.
*   SEND MINIMAL RESET FUNCTIONS TO TERMINAL.
*
*        INPUT:   DCB - IS ADDRESS OF OUTPUT DCB
*                 PLFCT - IS PENDING LINEFEED COUNT
*
*        OUTPUT:  PERFORMANCE OF FUNCTION.
*                 PLFCT, POS, PRHEAD RESET
*
*        SUBS:    LINEFEED
*                 M:WRITE
*                 RESETTM
*                 SETTM
*
*        USES:    ACC - PTR - SRTN
*                 SAVE - SAVE0
*
         LOCAL
*
RESET    RES      0
         STW,SRTN SAVE              SAVE RETURN ADDRESS LOCATION
         CALL     SETTM             SET TRANSPARENT MODE
         LW,ACC   PLFCT             NO, SO PREPARE TO ISSUE LINEFEEDS
         IF,NZ                      DOIF PREVIOUS ACTIVITY PENDING
         LI,PTR   0                 INITIALIZE PTR
         CALL     LINEFEED          DO LINEFEEDS
         M:WRITE  *FPT,(BUF,OUTBUF),(SIZE,*PTR),(WAIT)
         FI
         LI,PTR   RBUFPGNX          BYTE INDEX OF PAGE SIZE COUNT
         LW,ACC   PL                ACC GETS PAGE LENGTH
         STB,ACC  RBUFPGWD,PTR      STORE PAGE LENGTH IN BUFFER
         M:WRITE  *FPT,(BUF,RBUF),(SIZE,RBUFSIZ),(WAIT)
         CALL     RESETTM           RESTORE DCB STATE TO ORIGINAL
         LI,ACC   1
         STW,ACC  POS               POS1
         LI,ACC   0
         STW,ACC  PLFCT             PLFCT 0
         STW,ACC  PRHEAD            PRHEAD0
         B        *SAVE             RETURN
*
         TITLE    '                            RESET TM'
************************************************************
****************   RESET TRANSPARENT MODE   ****************
************************************************************
*
*   CANCEL ANY CHANGES WE MADE TO DCB IN SETTING TRANSPARENT
*   MODE.
*
*        INPUT:   TFLGS AS SET BY LAST CALL ON SETTM ROUTINE.
*                 DCB CONTAINS ADDRESS OF DCB
*
*        OUTPUT:  TFLGS IS -1
*
*        SUBS:    M:DEVICE
*
*        USES:    ACC - SRTN
*
RESETTM  RES      0
         LV,ACC   FMASK(DRCFLG)
         CS,ACC   TFLGS
         IF,EZ                      DOIF WE CHANGED DRC STATE
         M:DEVICE *FPT,(NODRC)
         STS,ACC  TFLGS             RESET DRC STATE CHANGE INDICATOR
         FI
         LV,ACC   FMASK(BINFLG)
         CS,ACC   TFLGS
         IF,EZ                      DOIF WE CHANGED BIN STATE
         M:DEVICE *FPT,(BCD)
         STS,ACC  TFLGS             RESET BIN STATE CHANGE INDICATOR
         FI
         EXIT                       RETURN
*
         TITLE    '                            SET TM'
**********************************************************
****************   SET TRANSPARENT MODE   ****************
**********************************************************
*
*   SET DRC AND BIN STATE IN DCB, UNLESS THEY ARE ALREADY SET.
*
*        INPUT:   DCB CONTAINS ADDRESS OF DCB
*
*        OUTPUT:  TFLGS IS UPDATED TO REFLECT CHANGE MADE TO DCB, AS
*                    0 = THIS BIT FLIPPED
*                    1 = NO CHANGE IN STATE MADE
*
*        SUBS:    M:DEVICE
*
*        USES:    ACC - SRTN
*
SETTM    RES      0
         LV,ACC   FMASK(DRCFLG)
         AND,ACC  *FPT              GET CURRENT STATE OF DRC FLAG
         IF,EZ                      DOIF NOT SET
         M:DEVICE *FPT,(DRC)
         FI
         STS,ACC  TFLGS             RECORD FLIP OR NO FLIP
         LV,ACC   FMASK(BINFLG)
         AND,ACC  *FPT              GET CURRENT STATE OF BIN FLAG
         IF,EZ                      DOIF NOT SET
         M:DEVICE *FPT,(BIN)
         FI
         STS,ACC  TFLGS             RECORD FLIP OR FLOP
         EXIT                       RETURN
*
         TITLE    '                            TABLANK'
*********************************************
****************   TABLANK   ****************
*********************************************
*
*   EXPAND INPUT LINE, SUBSTITUTING BLANKS FOR TABS.  ALSO NOTE
*   ANY WEIRD ESCAPE SEQUENCES, AND ABORT FORMATTING IF FOUND.
*   KEEP TRACK OF FIRST AND LAST PRINTING CHARACTER SEQUENCE IN
*   EXPANDED OUTPUT BUFFER.  STRIP TRAILING CARRIAGE RETURNS
*   AND LINEFEEDS.
*
*        INPUT:   BUFFER IS POINTER TO INPUT STRING
*                 C IS (POSSIBLE) BTD PLUS MAYBE A 1 IF VFC CHAR ADDED
*                 LBUFFER IS LENGTH (BYTES) OF INPUT STRING
*                 M:UC ASSUMED TO HAVE RELEVANT TAB STOP LIST
*
*        OUTPUT:  COUNT REPRESENTS THE POSITION (0-ORIGIN) OF THE FIRST
*                    'PRINTING' CHARACTER IN BUF.
*                 LPC REPRESENTS THE LAST SUCH.
*                 PRINT INDICATES THAT SOME PRINTING CHARACTERS WERE
*                    FOUND (1) OR NOT (0). COUNT AND LPC DON'T MEAN
*                    ANYTHING UNLESS PRINT IS 1.
*                 FFLAG = 1 MEANS THAT SOME WEIRD ESCAPE SEQUENCE
*                    WAS ENCOUNTERED, AND THE LINE SHOULD SIMPLY BE
*                    FLANG TO THE TERMINAL IN FORWARD PRINT MODE.
*                    IF 0, THEN:
*                 BUF IS THE GTH'S BEST GUESS AT WHAT THE INPUT LINE
*                    LOOKS LIKE WITH BLANKS SUBSTITUTED FOR TABS, ETC.
*
*        SUBS:    FTAB
*
*        USES:    ACC - C - T - SRTN - PT - LPC
*                 LBUFFER - SAVE
*
         LOCAL    %10,%20
*
TABLANK  RES      0
         STW,SRTN SAVE
         AWM,C    LBUFFER           GET PROPER LENGTH IN LBUFFER
         LI,LPC   -1                NO CURRENT CHARACTER
%10      RES      0
         LB,ACC   *BUFFER,C         GET NEXT CHAR
         IF,EQ    HT,ACC            IS IT TAB?
*
*   SUBSTITUTE BLANKS FOR TABS
*
         CALL FTAB                  FIND NEXT TAB
         LI,ACC   SP                PUT BLANK IN ACC
         AI,T     -2                T GETS COL OF TAB STOP-1
%20      RES      0
         STB,ACC  BUF,PT            STORE A BLANK
         AI,PT    1
         AI,LPC   1                 INCREASE  CARRIAGE POSITION
         CW,T     LPC               ARE TAB AND CARRIAGE POSITION THESAME
         BG       %20
*
         ELS
*
*   ANY OTHER CHARACTER GETS MOVED TO BUFFER
*
         STB,ACC  BUF,PT            NO, SET BUF+PTBUFFER+C
         IF,EQ    ESC,ACC           ESCAPE CHARACTER
         MTW,+1   FFLAG             YES, SO SET "AS IS" FLAG
         B        *SAVE             RETURN
*
         FI
         IF,EQ    CR,ACC            CARRIAGE RETURN   ?
*
*   HAVE A CARRIAGE RETURN IN A LINE
*   IF ITS THE LAST CHAR AND THE NEXT TO LAST IS A LINEFEED
*   DON'T INCLUDE EITHER IN THE OUTPUT BUFFER.
*   IF ITS THE LAST CHAR AND THE NEXT TO LAST ISN'T A LINEFEED
*   THEN EXCLUDE ONLY THE CARRIAGE RETURN FORM THE OUTPUT.
*   IF THE CR IS THE 2ND TO LAST AND THE LAST CHAR IS A LINEFEED
*   THEN DON'T INCLUDE EITHER.
*   OTHERWISE DO AS-IS PRINTING.
*
         AI,C     1                 INCREMENT C
         CW,C     LBUFFER           IS CR LAST INPUT CHAR?
         IF,EQ                      NO, SO CHECK IF CR IS 2ND TO LAST
         AI,C     -2                YES
         LB,ACC   *BUFFER,C         GET 2ND TO LAST CHAR
         IF,EQ    LF,ACC            IS IT A LINEFEED?
         AI,PT    -1                YES, SO DECREASE PT
         FI
         B        *SAVE             RETURN
*
         FI
         AI,C     1
         CW,C     LBUFFER           IS CR 2ND TO LAST CHAR?
         IF,GE                      NO, SO SET AS IS FLAG
         AI,C     -1
         LB,ACC   *BUFFER,C         GET LAST CHAR IN BUFFER
         CI,ACC   LF                IS IT A LINEFEED?
         BE       *SAVE             YES, SO RETURN
*
         FI
         MTW,1    FFLAG             FLAG1, FORWARD ONLY PRINTING
         B        *SAVE
*
         FI
         IF,EQ    BS,ACC            IS IT A BACKSPACE?
         AI,LPC   -1                YES, SO DECREASE CARRIAGE POS.
         FI
*
*   NOTHING SPECIAL - MIGHT IT PRINT?
*
         IF,G     SP,ACC            DOIF ABOVE SPACE
*
*        SET STUFF ON FIRST PRINTING CHARACTER FOUND
*
         IF,EQ    0,PRINT           DOIF 1ST
         LI,PRINT 1                 NO, SO SET IT
         STW,PT   COUNT             STORE POSITION OF FIRST PRINTABLE CHAR.
         STW,PT   LPC               AND, FOR NOW, LAST AS WELL.
         ELS                        NOT FIRST PRINTING
         AI,LPC   1
         FI
         ELSF,EQ                    DOIF SPACE
         AI,LPC   1
         FI
         AI,PT    1                 PTPT+1
         FI
         AI,C     1                 NO, SO INCR2EMENT
         CW,C     LBUFFER           C=LENGTH OF BUFFER?
         BL       %10               LOOP BACK
*
         B        *SAVE             RETURN
*
         TITLE    '                            VFCP'
******************************************
****************   VFCP   ****************
******************************************
*
*   CONVERT VFC CHARACTER TO LINEFEED COUNT
*
*        INPUT:   C IS INDEX TO VFC CHARACTER IN BUFFER
*
*        OUTPUT:  PLFCT UPDATED FOR VALID VFC CHARACTER
*                    (X'C0' - X'CF' OR X'F1')
*
*        USES:    ACC
*
*        NOTES:   NO ATTENTION IS PAID TO X'60' OR X'E0',
*                    WHICH SHOULD INHIBIT AUTO CRLF AFTER
*                    LINE -- JEQ.
*
         LOCAL
*
VFCP     RES      0
         LB,ACC   *BUFFER,C         GET VFC CHAR
         IF,LE    X'CF',ACC         IS VFC CODE <D0?
         THEF,G   X'C0',ACC         IS VFC CODE>C0?
         AV,ACC   -X'C0'            YES, SO GET # OF LINES TO SKIP
         AWM,ACC  PLFCT             INCREMENT LINEFEED COUNTER
         ELSF,EQ  X'F1',ACC         CHECK FOR TOP-OF-FORM
*
*   JUST SET LF COUNT TO GET US TO LINE AFTER BOTTOM OF PAGE
*
         LW,ACC   PL
         SW,ACC   POS
         AI,ACC   1
         STW,ACC  PLFCT             PLFCT := PL-POS+1
         FI
         EXIT                       RETURN
*
         TITLE    ' '
*
         END                        GTH1
