*DECK C$DSPLY 
          IDENT  C$DSPLY
          TITLE  C$DSPLY - DISPLAY A LINE ON OUTPUT FILE
  
          MACHINE  ANY,I
          COMMENT  DISPLAY A LINE ON OUTPUT FILE
          SST 
 TAF      IFEQ   OP.TAF,OP.NO 
          B1=1
          SPACE  4
**        CBSDPLY - COBOL DISPLAY VERB ROUTINE                          000060
*                                                                       000070
*         CALLING SEQUENCE                                              000080
*                SB4  NOAD
*                SB5  FWA                                               000100
*                SB6  OFFSET
*                SB7  SIZE
*                SA1  NAME OF UPON FILE 
*                RJ   C.DSPLY                                           000130
*                                                                       000140
*         USES                                                          000150
*                REGULAR INPUT OUTPUT ROUTINES (SEQUENTIAL) TO WRITE DAT000160
*                                                                       000170
*         DOES                                                          000180
*                WRITES DATA ON DISPLAY FILE                            000190
*                OPENS FILE IF NOT OPEN                                 000200
*                PUTS BLANK IN FRONT IF OUTPUT FILE                     000210
*                                                                       000220
*                CHANGES ALL REGISTERS                                  000230
*                                                                       000240
  
 CONSLL   EQU    40          MAX NO. CHARS POSSIBLE TO CONSOLE
 DSPCMRL  EQU    137         DEFAULT MRL FOR NON-CONNECTED FILES
 TERMMRL  EQU    72          DEFAULT TERMINAL MRL 
  
*CALL IODEFSC 
  
  
*CALL IOMICROS                                                          000250
  
          ENTRY  C.DSPLY                                                000270
 C.DSPLY  DATA   0                                                      000280
  
 DEBUGC   IFNE   DEBUGC,0    ASSEMBLE ONLY IF DEBUG COMPILER
          SB0    B1+TRAKON   JUMP  IF TRACKING
 DSPLY100 BSS    0
 DEBUGC   ENDIF 
  
          SX6    B4          NOAD 
          SA6    =SNOAD      SAVE IT
          SX6    B5          SENDING ADDR 
          SX4    B6          SENDING OFFSET (BCP) 
          LX4    30 
          BX6    X6+X4
          SA6    =SPARAM1    SAVE IT
          SX7    B7          SIZE 
          SA7    =SPARAM2    SAVE IT
          SA5    =XC.SYSF+#CONS#-1  GET NAME CONSOLE
          IX4    X1-X5
          NZ     X4,NOTCONS  JUMP IF NOT DISPLAY UPON CONSOLE 
          SX4    CONSLL      MAX LENGTH OF A LINE FROM THE CONSOLE
          MX6    0           NO BLANK INSERT
          SA6    =SBLANKIN   CLEAR BLANK INSERT FLAG
          MX7    1           CONSOLE FLAG 
          EQ     PROC1
 NOTCONS  BSS    0
          MX2    42 
          BX7    -X2*X1 
          BX1    X2*X1       CLEAR BLANK INSERT FLAG FROM LFN 
 OPSYS    IFC    NE,/"OSNAME"/SCOPE / 
          SA2    =XC.SYSF+#TERM#-1
          IX3    X2-X1
          NZ     X3,NTTERM1  JUMP IF NOT TERMINAL 
          MX7    0           CLEAR BLANK INSERT (NOT AVAIL ON KRONOS) 
 NTTERM1  BSS    0
 OPSYS    ENDIF 
          SA7    =SBLANKIN   SAVE BLANK INSERT FLAG 
          SA4    C.DSPLY
          SX7    =XC.OPOUT   OPEN ROUTINE ADDR
          SB2    WRITLIN
          SX6    B1 
          RJ     =XC.ACDSC   INITIALIZE 
 OPSYS    IFC    NE,/"OSNAME"/SCOPE / 
          FETCH  A0,CNF,X6
          PL     X6,NTCONCT  JUMP IF NOT CONNECTED
          MX6    0
          SA6    BLANKIN     CLEAR LEADING BLANK FLAG 
 NTCONCT  BSS    0
 OPSYS    ENDIF 
          FETCH  A0,RECA,X6  RECORD AREA ADDRESS
          SA6    =SSAVERA    SAVE OLD REC AREA ADDR 
          STORE  A0,RECA==XC.BUFF  PUT IN DISPLAY AREA
          FETCH  A0,CNF,X5
          SX4    DSPCMRL     DEFAULT FL FOR DISPLAY FILES 
          PL     X5,NTC1     JP IF NOT A CONNECTED FILE 
 OPSYS1   IFC    EQ,/"OSNAME"/SCOPE / 
          MX6    0
          SA6    =SRWEWD
          SYSTEM RWE,RCL,RWEWD     GET TERMINAL INFO
          SA1    RWEWD
          MX5    -10
          AX1    24 
          BX4    -X5*X1 
          ZR     X4,NOSCR    JP IF SCREEN WIDTH NOT SET 
          EQ     NTC1 
 NOSCR    BSS    0
 OPSYS1   ENDIF 
          SX4    TERMMRL     DEFAULT TERMINAL SIZE
 NTC1     BSS    0
          FETCH  A0,MRL,X6   GET MAX REC LEN FROM FIT 
          SA6    =SSVMRL     SAVE IT
          FETCH  A0,ACDMRL,X5 
          NG     X5,DSPLY.2  JUMP TO SET MRL
          BX4    X6 
          SA3    =XC.BUFFS
          SX2    10 
          IX3    X3*X2       BUFFER MAX CHR SIZE
          IX2    X3-X4
          PL     X2,DSPLY.3  JP IF C.BUFF BIG ENOUGH
          BX4    X3          USE SIZE OF C.BUFF 
          EQ     DSPLY.3
 DSPLY.2  BSS    0
          SA5    BLANKIN
          IX4    X4+X5       ADD IN ANY NEED FOR A BLANK INSERT 
          STORE  A0,MRL=X4
 DSPLY.3  BSS    0
          SX3    X4+9 
          SX5    1S20/10+1   1 TENTH
          IX3    X5*X3
          AX3    20          GIVES WORDS
          STORE  A0,RLWD=X3  PUT SIZE IN WORDS AWAY 
          SX3    X4-138 
          NG     X3,NOTBIG   MAX SIZE IS 137
          SX4    137
 NOTBIG   BSS    0
          MX7    0
 PROC1    BSS    0
          SA7    =SCONSFLG   SAVE CONSOLE FLAG
          SA1    PARAM1 
          SA2    PARAM2 
  
          LX4    30          MAX LENGTH 
          BX2    X4+X2       PUT MAX LEN IN PARAM 
          SA5    BLANKIN
          AX4    30 
          IX4    X4-X5
          NZ     X4,PRLOOP   JP IF MRL BIG ENOUGH 
          FETCH  A0,LFN,X6
          SA6    =XC.MSINS   INSERT FILE NAME 
          SX1    #DMRLS 
          MX2    1           NO INSERTS 
          SX3    WRITLIN     LINE NBR 
          MX6    1           ABORT JOB
          RJ     =XC.MSG     OUTPUT MESSAGE AND ABORT JOB 
 PRLOOP   BSS    0
          SA5    BLANKIN     BLANK INSERT FLAG
          SX3    X2          LENGTH REMAINING 
          IX3    X3+X5
          AX2    30          MAX LENGTH 
          IX4    X2-X3
          MX6    0
          PL     X4,NOTMAX   JUMP IF NOT MORE THAN MAX
          BX6    -X4         GIVES NUMBER LEFT IN INPUT AREA
          BX3    X2          LENGTH TO SEND 
 NOTMAX   BSS    0
          BX7    X3 
          SA7    =SRECLEN    SAVE NBR TO SEND 
          LX2    30          MAX LEN
          IX3    X7-X5       NUMBER OF CHARS TO MOVE FROM INPUT FIELD 
          SB7    X3          NUMBER OF CHARS TO MOVE
          LX3    30 
          IX7    X3+X1       NEW BCP = OLD + NUMBER MOVED 
          SA7    A1          RESET UPDATED PARAM1 
          BX7    X2+X6       PUT IN NBR LEFT
          SA7    PARAM2      PUT BACK 
          SA2    =XC.BLANK   SPACES 
          SA3    CONSFLG
          NZ     X3,CONS1    JIF DISPLAY ON CONSOLE (NO ADVANCING IGNOR)
          ZR     X5,ADVANCE  JIF CARRIAGE CONTROL USED
          FETCH  A0,NOAD,X4,4 
          PL     X4,ADVANCE  JIF NOT DISPLAYED WITH NO ADVANCING
          SA2    =1H+        FOR NO ADVANCING 
          SX5    1           FOR INSERT 
 ADVANCE  BSS    0
          SA4    NOAD        GET NEXT NOAD FLAG 
          BX6    X4 
          STORE  A0,NOAD=X6,4 SET NOAD FLAG FOR NEXT TIME 
 CONS1    BSS    0
          BX7    X2 
          SA7    =XC.BUFF    SET FIRST WORD TO SPACES (OF REC AREA) 
          SB3    A7          RECEIVER ADDRESS 
          SB4    X5          REC OFFSET (1 OR 0) FROM BLANKIN 
          SB5    X1          SENDING ADDRESS
          AX1    30 
          SB6    X1          SENDING OFFSET 
          MX2    0           NO BLANK FILL
          RJ     =XC.MOVE    MOVE DATA TO RECORD AREA 
          SA1    CONSFLG
          NZ     X1,DSPCONS  JP IF DISPLAY UPON CONSOLE 
 OPSYS    IFC    NE,/"OSNAME"/SCOPE / 
          SA1    66B         CHECK IF INTERACTIVE JOB 
          MX0    12 
          AX1    24 
          BX2    -X0*X1 
          SB2    X2-3 
          NZ     B2,NOTTERM  JUMP, IF NOT NOS INTERACTIVE JOB 
          FETCH  A0,CNF,X1   GET CONNECTED FILE FLAG
          PL     X1,NOTTERM  JUMP, IF NOT CONNECTED 
          SA1    NOAD        GET NOAD FLAG
          ZR     X1,NOTTERM  JUMP IF ADVANCING
          SA4    RECLEN 
          SX6    2           NUMBER OF -CHARS.- IN THE TERMINATOR 
          SX1    B4          B4 CONTAINS BCP OF NEXT FIELD - RETURNED 
          LX1    59               FROM C.MOVE 
          SB5    CURSORE     SENDING ADDRESS
          SB7    2           NBR CHARS IN CURSOR CONTROL
          PL     X1,EVEN     JUMP, IF BCP IS AN EVEN NUM. POSITION
          SB5    CURSORO     ADJUST SENDING ADDRESS 
          SX6    X6+1        ADD 1 FOR LONGER TERMINATOR
          SB7    B7+B1
*                            THE TERMINATOR MUST BE LINED UP AT BIT 
*                            POSITIONS 0, 12, 24, 36, OR 48 
 EVEN     IX7    X6+X4       ADD IN THE INCREASE IN THE LENGTH
          SA7    RECLEN      INCREASE THE RECLEN COUNT
*                            B3 IS ALREADY RECEIVING ADDRESS - RETURNED 
*                                 FROM C.MOVE 
          SB6    B0 
          MX2    0           NO BLANK FILL
          RJ     =XC.MOVE 
          EQ     NOTTERM
 CURSORE  DATA   00130000000000000000B
 CURSORO  DATA   55001300000000000000B
 NOTTERM  BSS    0
 OPSYS    ENDIF 
          SA3    RECLEN                                                 000600
          SB6    DSPRTN2     RETURN ADDRESS 
          MX4    0                                                      000620
          EQ     =XC.WRISQ   WRITE DISPLAY LINE 
 WRITLIN  DATA   0           LINE NUMBER IS PUT HERE FOR DIAGS
 DSPRTN2  BSS    0                                                      000640
          SA2    PARAM2 
          SX3    X2          NBR CHARS LEFT 
          ZR     X3,DSPEX    RETURN IF DONE 
          SA1    PARAM1      GET SENDING ADDRESS
          EQ     PRLOOP      GO DISPLAY ANOTHER LINE
 DSPEX    BSS    0
          SA1    CONSFLG
          NZ     X1,DSPEX2   JUMP IF A CONSOLE DISPLAY
          SA2    SAVERA      GET SAVED RECORD ADDRESS 
          STORE  A0,RECA=X2  RESTORE IT 
          SA2    SVMRL
          STORE  A0,MRL=X2   RESTORE OLD MRL
 DSPEX2   BSS    0
  
 DEBUGC   IFNE   DEBUGC,0    ASSEMBLE ONLY IF DEBUG COMPILER
          SA2    TRAKFLG
          ZR     X2,C.DSPLY  RETURN IF  NOT TRACKING ON ENTRY 
          MX6    0
          SA6    TRAKFLG     CLEAR TRACKING FLAG
          RJ     =XTRACK     TURN TRACK BACK ON WITH PARAMETERS RESTORED
          CON    4LASIS,-0
          EQ     C.DSPLY                                                000650
*                            STOP TRACKING WHILE IN THIS ROUTINE
 TRAKON   BSS    0
          SX6    B1 
          SA6    TRAKFLG     SET TRACKING FLAG
          RJ     =XUNTRACK   TURN TRACKING OFF
          EQ     DSPLY100 
 TRAKFLG  DATA   0           SET IF TRACKING ON ENTRY 
 DEBUGC   ELSE
          EQ     C.DSPLY
 DEBUGC   ENDIF 
  
 DSPCONS  BSS    0           DISPLAY ON CONSOLE 
          SA1    RECLEN      LENGTH OF MOVED STUFF
          SB5    BINZRS      TWO WORDS OF BINARY ZEROS
          SB3    C.BUFF      FWA OF MESSAGE 
          SB4    X1          BCP OF CHAR AFTER LAST ONE IN MESSAGE
          MX2    0           NO BLANK INSERT
          SB6    B0 
          SB7    11          MOVE 11 TO ASSURE TWO IN LOWER 
          RJ     =XC.MOVE    MOVE BINARY ZEROS TO END OF MESSAGE
          MESSAGE  C.BUFF,,R       DISPLAY THE MESSAGE
          EQ     DSPRTN2
 BINZRS   BSSZ   2
 SAVEPS   BSS    3
          ENTRY  C.OUTPT
 C.OUTPT  VFD    36/6HOUTPUT,18/0,6/1  WORD FOR DEFAULT DISPLAY 
 TAF      ELSE
          ENTRY  C.DSPLY
          ENTRY  C.OUTPT
          ENTRY  C.NOAD 
          EXT    C.ACMD 
          SYSCOM B1 
*COMMENT  CBDSPLY -  TAF/COBOL DISPLAY VERB PROCESSOR.
          COMMENT COPYRIGHT CONTROL DATA.        1978.
          TITLE  CBDSPLY - TAF/COBOL DISPLAY VERB PROCESSOR.
          SPACE  4
*****     CBDSPLY - TAF/COBOL DISPLAY VERB PROCESSOR. 
* 
*         W.E. MARTIN.       78/09/30.
          SPACE  4
***       CBDSPLY - TAF/COBOL DISPLAY VERB PROCESSOR. 
* 
*         PROCESS *DISPLAY* FROM DATA-NAME IN THE TRANSACTION 
*         ENVIRONMENT.  THE TELE-TYPE DEVICE IS THE ONLY DEVICE 
*         CURRENTLY SUPPORTED.  ANY REFERENCE TO THE SYSTEM 
*         CONSOLE IS IGNORED, AND NO REFERRENCE MADE TO THE FACT. 
*         INSTEAD OF ISSUING STANDARD *CIO/CRM* WRITES TO THE 
*         TERMINAL, THE TRANSACTION *CTI* REQUESTS WILL BE ISSUED.
* 
*         ENTRY  (B4) = NO-ADVANCE FLAG.
*                (B5) = FWA OF DATA-NAME. 
*                (B6) = CHARACTER OFFSET. 
*                (B7) = SIZE. 
*                (X1) = NAME OF UPON-FILE.
* 
*         EXIT   *SEND* OF DATA-NAME ISSUED TO TERMINAL.
* 
*         CALLS  C.MOVE.
* 
*         MACROS SYSTEM.
 TTYSIZE  EQU    72          TERMINAL MAXIMUM SIZE FOR OUTPUT.
          SPACE  4
          VFD    42/0LC.DSPLY,18/C.DSPLY
  
 DSP12    SA1    DSPA        RESTORE (A0) 
          SA0    X1+
  
 C.DSPLY  PS                 ENTRY/EXIT 
  
*         SAVE ENTRY PARAMETERS.
  
          SX7    B0+
          SA7    DSPI        CLEAR CURRENT CHARACTER COUNT
          SX6    A0          SAVE (A0)
          SX7    B4          SAVE NO-ADVANCE FLAG 
          SA6    DSPA 
          SB1    1
          SA7    DSPB 
          SX6    B5          (X6) = SENDING ADDRESS 
          SX7    B7+         (X7) = SIZE OF MESSAGE 
          SA6    DSPC 
          SA7    DSPD 
          SX6    B6 
          SA6    DSPF 
          SA1    DSPE        READ TELE-PROCESSOR STATUS 
          PL     X1,DSP1     IF *TPSTATUS* NOT PREVIOUSLY DETERMINED
          SYSTEM  CTI,R,DSPE,20  OBTAIN *TPSTATUS* (0=TELEX,1=NAM)
  
*         DETERMINE IF DATA TO BE DISPLAYED ON TERMINAL DEVICE MUST 
*         BE BLOCKED ACCORDING TO TERMINAL SIZE.
  
 DSP1     SA1    DSPE        READ BLANK INSERT FLAG 
          SX4    TTYSIZE+X1  (X4) = MAXIMUM SIZE OF TERMINAL
          SA2    DSPD        READ SIZE OF MESSAGE 
          IX3    X2+X1       (X3) = SIZE + BLANK INSERT FLAG
          IX5    X4-X3
          SX6    B0 
          PL     X5,DSP2     IF NOT MORE THAN MAXIMUM 
          BX6    -X5         REMAINING CHARS
          SX3    X4 
 DSP2     SA6    DSPD        SAVE REMAINING CHARS 
  
*         SET UP PARAMETERS FOR MOVE OF DATA FROM WORKING STORAGE TO
*         LEFT-JUSTIFIED RECEIVING BUFFER FOR SUBSEQUENT *SEND* TO
*         TRANSACTION TERMINAL. 
  
          SX0    X3+9        COMPUTE NUMBER OF TRAILING CHARACTERS
          SX4    10 
          IX0    X0/X4
          SX4    10 
          IX0    X0*X4
          IX2    X3-X0       (X2) = NUMBER OF BLANKS TO APPEND
          BX6    X3          SAVE CURRENT CHAR COUNT
          IX3    X3-X1       SIZE TO MOVE 
          SB7    X3          (B7) = NUMBER OF CHARACTERS TO MOVE
          SA5    DSPF        SENDING OFFSET 
          IX7    X3+X5       SAVE NEW BCP 
          SA7    A5 
          SB3    C.ACMD+4    (B3) = FWA OF WORKING BUFFER 
          SB4    X1          (B4) = RECEIVING RECORD CHARACTER OFFSET 
          SB6    X5          (B6) = SENDING OFFSET
          SA5    DSPC        SENDING ADDRESS
          SB5    X5          (B5) = FWA OF SENDER 
          SA5    DSPB        READ *NO-ADVANCE* FLAG 
          ZR     X5,DSP3     IF *NO-ADVANCE* NOT REQUESTED
          SX2    B0          (X2) = NO BLANKS APPENDED
 DSP3     IX6    X6-X2       INCREMENT CURRENT CHARACTER COUNT, NOTE: 
          SA6    DSPI        X2 IS NEG. NO. OF BLANKS TO APPEND 
          RJ     =XC.MOVE    MOVE DATA TO RECORD AREA 
          SA1    DSPB        READ *NO-ADVANCING* FLAG 
          ZR     X1,DSP4     IF *NO-ADVANCING* NOT REQUESTED
          RJ     SEL         SET END OF LINE
          EQ     DSP7        PROCESS *SEND* HEADER
  
*         COMPRESS OUT TRAILING BLANKS, IF THIS *DISPLAY* IS NOT
*         REQUESTED WITH *NO-ADVANCING*.
  
 DSP4     SA1    C.ACMD+4    (A1) = FWA OF MESSAGE
          SA2    DSPI        READ CHARACTER COUNT 
          RJ     TTB         TRUNCATE TRAILING BLANKS 
          MX0    -12
          BX6    -X0*X4 
          SX5    2R 
          BX6    X5-X6
          NZ     X6,DSP5     IF EOL NOT POSSIBLE IN THIS BYTE 
          BX1    X4 
          RJ     ZFW         ZERO FILL WORD 
          BX6    X1 
          EQ     DSP6        CONTINUE PROCESSING *SEND* 
  
*         PREPARE *SEND* HEADER WITH ABH AND ADJUSTED CHARACTER COUNT.
  
 DSP5     SX6    B0+
          SB4    B4+B1       SET EOL IN WORKING STRAGE BUFFER 
 DSP6     SA6    C.ACMD+4+B4
 DSP7     MX0    42          SET WORD COUNT IN HEADER 
          SA3    DSPH        READ *SEND* HEADER 
          BX7    X0*X3
          SB4    B4+B1       (B4) = WORD COUNT
          SX5    B4          (X5) = TRUNCATED WORD COUNT
          IX7    X7+X5
          SX6    B4          SET CHARACTER COUNT INTO ABH 
          SX5    10          (X5) = NUMBER OF CHARACTERS IN WORD
          SA7    C.ACMD 
          IX6    X6*X5
          SA1    DSPG        READ SKELETON ABH
          BX7    X6+X1
          SA7    C.ACMD+2 
          SA1    DSPE        READ BLANK-INSERT FLAG 
          ZR     X1,DSP9     IF NOT *NAM* TELE-PROCESSING MODE
          MX0    -54         SET FORMAT EFFECTOR
          SX7    1R.         (X7) = FORMAT EFFECTOR FOR CURSOR RETURN 
          SA1    DSPB        READ *NO-ADVANCE* FLAG 
          ZR     X1,DSP8     IF NO-ADVANCE NOT REQUESTED
          SX7    1R+         (X7) = FORMAT EFFECTOR FOR NO-ADVANCE
 DSP8     SA1    C.ACMD+4    READ FWA OF MESSAGE
          BX6    -X0*X1 
          LX7    59-5 
          BX6    X6+X7
          SA6    A1+
  
*         ISSUE *SEND* TO TRANSACTION TERMINAL. 
  
 DSP9     SYSTEM CTI,R,C.ACMD      ISSUE *SEND* 
  
*         CLEAR BUFFER FOR SUBSEQUENT REUSE.
  
          MX0    -18
          SA5    C.ACMD      READ BUFFER HEADER 
          SB4    X5          (B4) = WORD COUNT OF PREVIOUSLY SENT DATA
          LX5    30 
          BX5    -X0*X5 
          SB5    X5          (B5) = FWA OF DATA BUFFER SEGMENT
          SA5    =XC.BLANK
          BX6    X5 
 DSP11    SA6    B5+B4       RESTORE WORD TO BLANKS 
          SB4    B4-B1
          GE     B4,DSP11    IF REMAINING WORDS TO CLEAR
  
*         LOOP IF MORE CHARACTERS TO SEND 
  
          SA2    DSPD 
          SX3    X2 
          NZ     X3,DSP1
  
*         SET GLOBAL NO ADVANCE FLAG AND EXIT 
  
          SA1    DSPB 
          ZR     X1,DSP12 
          BX7    X1 
          SA7    C.NOAD 
          EQ     DSP12       CONTINUE SENDING DATA TO TERMINAL
  
 DSPA     CON    0           STORAGE FOR (A0) 
 DSPB     CON    0           STORAGE FOR (B4) - NO-ADVANCE FLAG 
 DSPC     CON    0           STORAGE FOR FWA
 DSPD     CON    0           STORAGE FOR (B7) - SIZE
 DSPE     CON    -1          STORAGE FOR BLANK-INSERT FLAG(NAM OR IAF)
 DSPF     CON    0           STORAGE FOR BCP
  
*         STORAGE FOR ABH WITH *FORMAT EFFECTOR* REQUESTED. 
  
 DSPG     VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/0,3/0,12/0 
  
*         STORAGE FOR *SEND* HEADER WITH ABH PRESENT. 
  
 DSPH     VFD    1/0,1/0,1/0,1/0,1/0,1/1,6/0,18/C.ACMD+4,12/0,18/14 
 DSPI     CON    0           STORAGE FOR CURRENT SIZE 
 C.NOAD   CON    0           STORAGE FOR GLOBAL NO-ADVANCING FLAG 
 C.OUTPT  VFD    36/6HOUTPUT,18/0,6/1  WORD FOR DEFAULT DISPLAY 
 TTB      SPACE  4,15 
**        TTB - TRUNCATE TRAILING BLANKS. 
* 
*         TRUNCATE TRAILING BLANKS IN ORDER TO REDUCE TRANSMISSION
*         TIME OF BLANK FILLED CHARACTER STRINGS.  THIS IS OF PRIMARY 
*         INTEREST TO THE *COBOL* PROGRAMMER WHO IS TRYING TO UTILIZE 
*         FIXED LENGTH RECORD DESCRIPTORS AND VARIABLE LENGTH DATA
*         TO BE DISPLAYED ON THE TERMINAL.
* 
*         ENTRY  (A1) = FWA OF MESSAGE. 
*                (X2) = CHARACTER COUNT OF MESSAGE. 
* 
*         EXIT   (X4) = LAST WORD EXAMINDED.
*                (B4) = WORD OFFSET TO THE LAST NON-BLANK WORD. 
* 
*         USES   A - 4, 5.
*                B - 4, 7.
*                X - 2, 4, 5, 7.
  
  
 TTB      PS                 ENTRY/EXIT 
          SX7    X2-11
          SB4    B0          PRE-SET POSSIBLE EXIT CONDITIONNS
          BX4    X1          PRE-SET POSSIBLE EXIT CONDITION
          NG     X7,TTB      IF MESSAGE LENGTH ONE WORD OR LESS 
          SX5    X2+9        COMPUTE NUMBER OF WORDS IN MESSAGE 
          SX4    10          (X4) = NUMBER OF CHARACTERS IN WORD
          IX5    X5/X4
          SB4    X5 
          SB4    B4-B1
          SA5    =XC.BLANK   (X5) = 10H 
 TTB1     SA4    A1+B4       READ WORD OF MESSAGE 
          ZR     X4,TTB2     IF LAST WORD ZERO
          BX7    X4-X5
          NZ     X7,TTB      IF NON-BLANK CHARACTER - RETURN
 TTB2     EQ     B4,TTB      RETURN, IF BUFFER ALL EXAMINED 
          SB4    B4-B1       DECREMENT WORD INDEX 
          SX2    X2-10       DECREMENT CHARACTER COUNT
          EQ     TTB1        CONTINUE SEARCHING 
 ZTW      SPACE  4,15 
**        ZFW - ZERO FILL WORD. 
* 
*         ZERO FILL WORD REMOVES TRAILING BLANKS FROM A WORD WHICH
*         MIGHT CONTAIN EITHER ZERO OR BLANK FILL.
* 
*         ENTRY  (X1) = WORD TO BE ZEROED.
* 
*         EXIT   (X1) = WORD, ZERO-FILLED.
* 
*         USES   X - 1, 2, 3, 4, 6. 
*                B - 2. 
  
  
 ZFW      PS                 ENTRY/EXIT 
          ZR     X1,ZFW      IF WORD IS ALREAD ZERO - RETURN
          MX2    -6 
          SX4    1R 
 ZFW1     BX3    -X2*X1      EXTRACT NEXT CHARACTER 
          ZR     X3,ZFW2     IF THIS CHARACTER IS ALREADY ZERO
          BX3    X3-X4
          NZ     X3,ZFW      IF NON-BLANK CHARACTER 
          BX1    X2*X1       REPLACE BLANK CHARACTER WITH ZERO
 ZFW2     LX2    6
          LX4    6
          ZR     X1,ZFW      IF WORD NOW ALL ZEROS - RETURN 
          EQ     ZFW1        CONTINUE EXTRACTING BLANKS 
 SEL      SPACE  4,15 
**        SEL - SET END OF LINE.
* 
*         SET END OF LINE FOR THOSE LINES WHICH MUST NOT UNDERGO BLANK
*         COMPRESSION DUE TO THE SCREEN CURSOR POSITIONING WHICH
*         *NO-ADVANCING* PROVIDES.
* 
*         ENTRY  (B4) = NEXT BCP (FROM C.MOVE)
*                (B3) = FWA OF FIELD AFTER RECEIVING FIELD. 
*                (DSPE) = TELE-PROCESSOR MODE FLAG. 
* 
*         EXIT   (B4) = WORD OFFSET TO LAST NON-BLANK WORD
*                IF IN *NAM* MODE - EOL SET IN BUFFER.
*                IF IN *TELEX* MODE - CONTROL BYTE AND EOL SET. 
* 
*         USES   A - 1, 2, 6. 
*                X - 0, 1, 2, 6.
*                B - 2, 4, 5, 6, 7. 
* 
*         CALLS  C.MOVE.
  
  
 SEL3     NZ     B4,SEL4     IF BCP NOT IN NEXT WORD
          SB4    C.ACMD+4+1  (B4) = COMPENSATED FWA OF BUFFER 
          EQ     SEL5        SET WORD COUNT 
  
 SEL4     SB4    C.ACMD+4 
 SEL5     SB4    B3-B4       (B4) = WORD COUNT IN MESSAGE 
  
 SEL      PS                 ENTRY/EXIT 
          SA1    DSPE        READ TELEPROCESSING MODE 
          ZR     X1,SEL1A    IF IN *TELEX* MODE 
          SB2    B4 
          SX6    B0 
          SB4    B4+B1
          EQ     B4,B1,SEL1  IF LAST CHARACTER IN PRECEDING WORD
          SB4    B4-B1
          SX6    6           COMPUTE BIT LENGTH OF CHARACTERS PRESENT 
          SX1    B2          (X1) = CHARACTER COUNT 
          IX6    X1*X6
          SA2    B3          READ LWA OF ADJUSTED STRING
          SX6    X6-1 
          SB2    X6          (B2) = COMPENSATED BIT COUNT 
          MX0    1
          AX0    B2          (X0) = SIGNIFICANT CHARACTER MASK
          BX6    X0*X2       SET END OF LINE
 SEL1     SA6    B3 
          EQ     SEL3 
 SEL1A    SB7    10 
          SB7    B7-B4       (B7) = NUMBER OF CHARCTERS FOR EOL 
          SX1    B4 
          LX1    59 
          SB5    SELA        (B5) = TELEX CARRIAGE-RETURN SUPPRESS
          PL     X1,SEL2     IF BCP IS IN AN EVEN POSITION
          SB5    SELB        (B5) = TELEX CARRIAGE-RETURN SUPPRESS
          NE     B7,B1,SEL2 
          SB7    11          EOL MUST BE AT LEAST 2 CHARS LONG
 SEL2     MX2    0           (X2) IMPLIES APPEND NO TRAILING BLANKS 
          SB6    B0          (B6) = CONTROL BYTE OFFSETS
          RJ     =XC.MOVE 
          EQ     SEL3 
*         STORAGE FOR *TELEX* CARRIAGE-RETURN SUPPRESSION 
*         CONTROL-BYTES.
  
 SELA     DATA   00130000000000000000B
 SELB     DATA   55001300000000000000B
          DATA   0
          SPACE  4
 TAF      ENDIF 
          END                                                           000660
