*COMDECK  CSTRCCL 
          TITLE  CSTRCCL - STRING PROCESSING (STRCCL) SUBROUTINES 
**        STRCCL  -  STRING ROUTINES FOR CCL                            000160
*                                                                       000170
*         STRCCL CONSISTS OF SEVERAL SUBROUTINES WHOSE                  000180
*         OVERALL PURPOSE IS TO AID IN THE CRACKING OF A CONTROL        000190
*         STATEMENT INTO CHARACTER STRINGS AND IDENTIFING THE           000200
*         SEPARATOR FOLLOWING THAT STRING.                              000210
*         THE METHOD USED TO ACCOMPLISH THIS IS TO SCATTER              000220
*         THE LINE (CARD) INTO A BUFFER WITH ONLY ONE CHARACTER         000230
*         PER WORD.  THE ONE CHARACTER IS RIGHT JUSTIFIED IN THE WORD.
*         THEN EACH CALL TO THE ASSEMBLY SUBROUTINE (STRANS) PACKS      000250
*         CHARACTERS INTO A STRING, LEFT JUSTIFIED, TEN CHARACTERS      000260
*         PER WORD UNTIL A SEPARATOR IS ENCOUNTERED.                    000270
*         TO MAINTAIN POSITION INFORMATION THE FIRST WORD OF THE        000280
*         BUFFER IS USED TO STORE THE TOTAL NUMBER OF CHARACTERS        000290
*         IN THE BUFFER AND THE CURRENT POSITION OF THE ASSEMBLY        000300
*         PROCESS.                                                      000310
*                                                                       000320
*         THE SUBROUTINES   -                                           000330
*         STRFZB  -  FIND ZERO BYTE DETERMINES WORDS UNTIL A Z BYTE     000340
*         STRUPS  -  UNPACK STRING,                                     000350
*         STRDTC  -  DELETE TRAILING CHARACTERS                         000360
*         STRANS  -  ASSEMBLE NEXT STRING 
*         STREVL  -  EVALUATE LITERAL                                   000380
*         STREVN  -  EVALUATE NUMERIC                                   000390
*         STRPKS  -  PACK STRING                                        000400
*         STRMSG  -  ASSEMBLE AND ISSUE DAYFILE MESSAGE                 000410
*                                                                       000420
*         IN GENERAL STRFZB IS CALLED TO DETERMINE THE NUMBER OF        000430
*         WORDS IN A LINE (CARD).  THEN STRUPS IS CALLED TO             000440
*         UNPACK THE LINE INTO THE BUFFER.  STRDTC IS CALLED            000450
*         TO DELETE TRAILING CHARACTERS (EITHER ZERO CHARACTERS         000460
*         OR ZERO CHARACTERS AND THEN ANY TRAILING BLANKS)              000470
*         STRANS IS THEN CALLED REPEATEDLY ASSEMBLING A STRING          000480
*         AND IDENTIFING THE SEPARATOR.                                 000490
*                                                                       000500
*         AFTER A CALL TO STRANS INFORMATION ABOUT THE ASSEMBLED        000510
*         STRING IS AVAILABLE IN THE COMMON BLOCK COMALL. 
*         AVAILABLE INFORMATION IS THE STRING ITSELF, NUMBER OF         000530
*         CHARACTERS, LITERAL AND NUMERIC FLAGS.  IF THE STRING IS      000540
*         A LITERAL AN EVALUATED STRING AND NUMBER OF CHARACTERS        000550
*         ARE ALSO AVAILABLE.                                           000560
*                                                                       000570
*         IF THE STRING IS A NUMERIC A SEPARATE CALL TO STREVN          000580
*         IS NECESSARY TO EVALUATE THE STRING TO A BINARY VALUE.        000590
*                                                                       000600
*         STRMSG IS A SUBROUTINE WHICH USES THE STRING ROUTINES         000610
*         TO CONCATENATE AS MANY AS THREE STRINGS                       000620
*         AND THEN DAYFILING THE RESULT.                                000630
*                                                                       000640
          B1=1   B1= 1 THROUGHOUT CCL                                   000710
          TITLE  CSTRCCL - STRANS - ASSEMBLE NEXT STRING
**        STRANS  -  ASSEMBLE NEXT STRING                               000800
*                                                                       000810
*         ENTRY  A2  = SCATTER BUFFER HEADER ADDRESS                    000820
*                X2  = SCATTER BUFFER HEADER                            000830
*                B1  = 1                                                000840
*                                                                       000850
*         EXIT   - ANS DATA SET IN COMMON AREA
*                - SCATTER BUFFER HEADER (CURRENT) UPDATED              000870
*                B1  = 1                                                000880
*                                                                       000890
                                                                        000900
 STRANS   SUBR   =                                                      000910
          BX7    X2                                                     000920
          SB4    X2          CURRENT POSITION                           000930
          SA7    ANSHBA      SAVE CURRENT HEADER                        000940
          AX7    S.SBTOT-N.SBTOT+1                                      000950
          MX6    0                                                      000960
          SB3    X7          NUMBER OF CHARACTERS                       000970
          SA0    B0          CLEAR CHARACTER COUNT                      000980
          SA6    ANSLIT      ZERO LITERAL FLAG                          000990
          SB5    A2+B1       ADDRESS OF ENTRY ZERO                      001000
          SB6    B0          CLEAR LITERAL FLAG                         001010
          SA6    ANSEVLC                                                001020
          SX7    1R                                                     001030
          SB2    -B1                                                    001040
          SX6    1R                                                     001050
          NE     B0,B4,ANS1  IF NOT AT START OF BUFFER                  001060
                                                                        001070
*         FORCE ANSPSP TO BE BLANK AFTER THE CALL                       001080
*         WHICH STARTS AT THE HEAD OF THE SCATTER BUFFER                001090
                                                                        001100
          SA7    ANSSEP                                                 001110
 ANS1     BSS                                                           001120
          MX6    0           CLEAR ASSEMBLY REGISTER                    001130
          SB2    B1+B2       RELATIVE WORD WITHIN ANSSTR                001140
          SB7    60                                                     001150
 ANS2     BSS                                                           001160
          MX3    1           ASSUME EXIT WILL BE TAKEN                  001170
          GE     B4,B3,ANS6  EXIT IF END OF STRING WITHOUT SEPARATOR    001180
          SA3    B5+B4       NEXT CHARACTER                             001190
          SX4    1R9+1                                                  001200
          SB4    B4+B1                                                  001210
          IX0    X3-X4                                                  001220
          PL     X0,ANS4     IF SEPARATOR GT 9                          001230
          ZR     X3,ANS4     IF COLON                                   001240
                                                                        001250
 EXP      IFNE   PB.EXP,0 
          SA4    INHIBEXP 
          ZR     X4,ANS3     IF NOT DOING STATEMENT EXPANSION 
          BX0    X3-X4
          SA4    A4+B1
          ERRNZ  CCATENAT-INHIBEXP-1  CODE DEPENDS ON RELATIVE LOCATION 
          ZR     X0,ANS4     IF INHIBIT CHARACTER 
  
          BX0    X3-X4
          ZR     X0,ANS4     IF CONCATENATION CHARACTER 
 EXP      ENDIF 
  
 ANS3     BSS                                                           001260
          LX6    6                                                      001270
          SB7    B7-6                                                   001280
          BX6    X3+X6       ADD CHARACTER                              001290
          SA0    A0+B1       INCREMENT CHARACTER COUNT                  001300
          LT     B0,B7,ANS2  IF ASSEMBLY REGISTER NOT FULL              001310
          SA6    ANSSTR+B2                                              001320
          JP     ANS1                                                   001330
                                                                        001340
 ANS4     BSS                                                           001350
          NE     B0,B6,ANS5  IF ASSEMBLING LITERAL                      001360
          SA5    IACIPF      CHECK INTERACTIVE PROCESSING FLAG
          ZR     X5,ANSI01   FLAG OFF - CONTINUE
  
          SA5    IACDSF      DESCRIPTION FLAG 
          ZR     X5,ANSI01   FLAG OFF - CONTINUE
  
          SX7    X3-1R"      ASSEMBLING PROMPT STRING 
          SA4    ANSPSP      CHECK PREVIOUS SEPARATOR 
          SX5    X3-1R] 
          ZR     X7,ANS4A    TURN OFF DESCRIPTION FLAG
  
          SX7    X3-70B      CHECK FOR APOSTROPHE 
          ZR     X7,ANS4AA   CHECK PREVIOUS SEPARATOR 
          NZ     X5,ANS3     PACK SEPARATOR INTO ASSEMBLY REG 
  
          SX7    X4-1R[      DESCRIPTION MUST BEGIN WITH [
          NZ     X7,ANS3     GET REST OF STRING 
          JP     ANS4B       TURN OFF DESCRIPTION FLAG
  
 ANS4A    BSS    0
          SX5    X4-1R"      DESCRIPTION MUST BEGIN WITH QUOTE
          NZ     X5,ANS3     GET REST OF STRING 
          JP     ANS4B       TURN OFF DESCRIPTION STRING
  
 ANS4AA   BSS    0
          SX5    X4-70B      CHECK FOR APOSTROPHE 
          NZ     X5,ANS3     GET REST OF STRING 
  
  
 ANS4B    BSS    0
  
          MX7    0           TRAILING QUOTE FOUND - TURN OFF FLAG 
          SA7    IACDSF 
          JP     ANS6        EXIT - RETURN WITH QUOTE SEPARATOR 
  
 ANSI01   BSS    0
          SA5    ANSMDE                                                 001370
          SX4    X3-1R* 
          SX0    X3-1R
          SX7    X3-1R$ 
          PL     X5,ANS4.5   IF * IS A SEPARATOR
  
          ZR     X4,ANS3     ACCEPT * AS VALID CHARACTER
  
          SX4    X5+1 
          PL     X4,ANS4.5   IF NOT IGNORING DELIMITERS 
  
          NZ     X7,ANS3     IF NOT BEGINNING OF LITERAL
  
          JP     ANS4.6      BEGIN ASSEMBLING LITERAL 
  
 ANS4.5   BSS    0
          NZ     X5,ANS6     IF ALL ARE SEPARATORS                      001380
          ZR     X0,ANS2     IGNORE IF BLANK                            001430
          NZ     X7,ANS6     EXIT IF VALID SEPARATOR                    001440
                                                                        001450
*         ALLOW $ BEFORE VERB ON NOS (DON-T PROCESS AS LITERAL) 
  
 ANS4.6   BSS    0
 OSNOS    IFEQ   HOST,NOS 
          SA4    ANSVRB 
          ZR     X4,ANS6     NO VERB PRESENT - IGNORE $ 
  
 OSNOS    ENDIF 
  
*         BEGIN ASSEMBLING LITERAL                                      001460
                                                                        001470
          SX7    B1          X7=1                                       001480
          SB6    B1          SET ASSEMBLING LITERAL FLAG                001490
          SA7    ANSLIT      SET LITERAL FLAG IN ANS DATA               001500
          JP     ANS3        ENTER $ IN STRING                          001510
                                                                        001520
*         WHEN ASSEMBLING A LITERAL ALL CHARACTERS ARE ASSEMBLED.  THE  001530
*         END OF THE LITERAL IS A SINGLE DOLLAR ($).  WHEN A DOLLAR     001540
*         IS ENCOUNTERED THE NEXT CHARACTER IS EXAMINED.  IF BOTH       001550
*         ARE DOLLARS THE DOUBLE DOLLAR FLAG (B6) IS SET SO THAT        001560
*         THE SECOND $ WILL BE ASSEMBLED WITHOUT THE $ CHECK.           001570
*         NOTE THAT THE DOLLAR SIGN WHICH TERMINATES A LITERAL          001580
*         IS NOT A SEPARATOR, THE ASSEMBLY CONTINUES.                   001590
                                                                        001600
 ANS5     BSS                                                           001610
          SX0    B6                                                     001620
          SB6    B1                                                     001630
          NG     X0,ANS3     TRANSFER $ IF IT IS SECOND OF DOUBLE$      001640
                                                                        001650
          SX5    1R$                                                    001660
          BX0    X3-X5                                                  001670
          NZ     X0,ANS3     IF NOT $, CONTINUE ASSEMBLING LITERAL      001680
          SB6    B0          ASSUME THIS $ TERMINATES LITERAL           001690
          SA4    B4+B5       GET NEXT CHARACTER                         001700
          GE     B4,B3,ANS3  IF THIS $ IS LAST CHARACTER                001710
          BX0    X4-X5                                                  001720
          NZ     X0,ANS3     IF THIS $ TERMINATES LITERAL               001730
          SB6    -B1         THIS $ IS FIRST OF $$                      001740
          JP     ANS3        ENTER $ IN ASSEMBLY AND CONTINUE ASSEMBLY  001750
                               SEARCHING FOR SEPARATOR.                 001760
                                                                        001770
                                                                        001780
                                                                        001790
*                A0  = NUMBER OF CHARACTERS IN STRING                   001800
*                A2  = BUFFER HEADER ADDRESS                            001810
*                X2  = BUFFER HEADER                                    001820
*                X3  = SEPARATOR,  IF NO SEP. THEN SIGN BIT SET         001830
*                X6  = ASSEMBLY REGISTER                                001840
*                B2  = POSITION IN ANSSTR                               001850
*                B4  = CURRENT POSITION IN SCATTER BUFFER               001860
*                B6  = LITERAL ASSEMBLY FLAG                            001870
*                B7  = SHIFT COUNT OF CURRENT REGISTER                  001880
                                                                        001890
 ANS6     BSS                                                           001900
          SA1    ANSMDE 
          ZR     B6,ANS6.1   IF NOT AN UNTERMINATED LITERAL 
  
          SX7    X1+2 
          NZ     X7,ANS8     IF NOT IGNORING DELIMITERS 
  
*         STRING IS NOT REALLY A LITERAL. 
  
          SA7    ANSLIT      CLEAR LITERAL FLAG 
  
 ANS6.1   BSS    0
          SA5    IACDSF      TRAILING QUOTE NOT FOUND 
          NZ     X5,ANS9     ISSUE ERROR MESSAGE
  
          SA5    ANSSEP      GET PREVIOUS SEPARATOR                     001930
          LX6    X6,B7                                                  001940
          SX7    A0                                                     001950
          SA6    ANSSTR+B2   STORE PARTIAL REG, OR ZERO ANSSTR IF NULL  001960
          SA7    ANSCHR      STORE NUMBER OF CHARACTERS                 001970
          MX6    0
          BX7    X3                                                     001990
          SA6    A6+B1       ENSURE ZERO BYTE 
          SA7    ANSSEP      STORE CURRENT SEPARATOR                    002010
          BX6    X5 
          MX7    -N.SBCUR                                               002020
          SA6    ANSPSP      SET PREVIOUS SEPARATOR 
          SX0    B4          NEW POSITION                               002030
          BX2    X2*X7       CLEAR OLD POSITION                         002040
          BX7    X0+X2                                                  002050
          BX2    X0+X2       UPDATE HEADER IN X2                        002060
          SA7    A2          UPDATE HEADER                              002070
          SA5    ANSSTR                                                 002080
          SA4    ANSLIT                                                 002090
          MX0    -6                                                     002100
          LX5    6           SHIFT FIRST CHARACTER                      002110
          BX0    -X0*X5      EXTRACT FIRST CHARACTER                    002120
          MX6    0           ASSUME NUMERIC                             002130
          SX0    X0-1R0                                                 002140
          NZ     X4,ANS7     IF LITERAL IT IS NOT NUMERIC               002150
          NG     X0,ANS7     IF ALPHA                                   002160
          SX6    1                                                      002170
 ANS7     BSS                                                           002180
          SA6    ANSNUM      1 IF NUMERIC ELSE 0                        002190
          ZR     X4,STRANS   EXIT IF NOT LITERAL                        002200
                                                                        002210
          SA1    ANSSTR                                                 002220
          RJ     STREVL      EVALUATE LITERAL                           002230
                                                                        002240
          JP     STRANS      EXIT                                       002250
                                                                        002260
 ANS8     BSS                                                           002270
                                                                        002280
*         ERROR - LITERAL NOT TERMINATED PROPERLY                       002290
          SX3    MSG303                                                 002300
          SA2    PBCOND 
          SA1    IACICF 
          NZ     X2,ANS8.5   RETURN WITH MESSAGE .IF/.ELSE/.ENDIF 
          ZR     X1,=XBRWERR5  DAYFILE ERR MSG AND BAD LINE 
  
 ANS8.5   BSS    0
          BX7    X3 
          SA7    IACERR      STORE ERR CONDITION
          JP     STRANS      RETURN 
  
 ANS9     BSS    0
  
*         DESCRIPTION STRING NOT PROPERLY TERMINATED
  
          SX3    MSG334      MISSING QUOTE
          SA1    ANSPSP 
          SX0    X1-1R[ 
          NZ     X0,=XBRWERR5  DAYFILE CCL334 AND BAD LINE
  
          SX3    MSG335      DESCRIPTION MISSING BRACKET
          JP     =XBRWERR5   DAYFILE CCL335 AND BAD LINE
  
 STRCADC  TITLE  CSTRCCL - STRCADC - CONVERT ASCII TO DISPLAY CODE
**        STRCADC - CONVERT ASCII TO DISPLAY CODE 
* 
*         ON NOS/BE AND SCOPE 2 STRCADC RETURN JUMPS
*         TO STRUPS WITHOUT CONVERSION
* 
*         NOS - IF THE CALL WAS INTERACTIVE STRCADC 
*               RETURN JUMPS TO STRUPS AND THEN RETURNS 
* 
*             - IF THE CALL WAS NON-INTERACTIVE THE TEXT
*               IS UNPACKED WITH CONVERSION FROM ASCII
*               TO DISPLAY CODE.  UNPACKING TERMINATES BY 
*               THE CHARACTER COUNT OR THE SIZE OF BUFFER.
* 
*         ENTRY  A1 = ADDRESS OF STATEMENT
*                X1 = 1ST 10 CHARACTERS TO UNPACK 
*                A2 = SCATTER BUFFER HEADER ADDRESS 
*                X2 = SCATTER BUFFER HEADER 
*                B1 = 1 
*                B2 = NUMBER OF CHARACTERS TO UNPACK
* 
*         EXIT   A2 = SCATTER BUFFER HEADER ADDRESS 
*                X2 = UPDATED SCATTER BUFFER HEADER 
*                B1 = 1 
*                B3 = TOTAL CHARACTERS IN BUFFER
* 
* 
 STRCADC  SUBR   =
          SA4    IACIDP 
          ZR     X4,CADC5          NO DIALOG - PERFORM CONVERSION 
  
          RJ     STRTASC           ASCII CONVERSIONS FOR NBE DIALOGUE 
          JP     STRCADC           STRING UNPACKED - RETURN 
  
 CADC5    BSS    0
          SB4    V.SBSIZ           MAX SIZE OF BUFFER 
          EX3    X2,SBTOT 
          SB3    X3 
          MX7    0                 CLEAR REMAINING SPACE
          SB5    B3                TOTAL USED WORDS 
  
 CADC10   BSS    0                 CLEAR BUFFER 
          SB5    B5+B1             INCREMENT POSITION 
          SA7    A2+B5
          LT     B5,B4,CADC10      KEEP CLEARING
  
          SB5    A2+B1             1ST WORD IN BUFFER 
          GE     B0,B2,STRCADC     RETURN - NOTHING TO DO 
          GE     B3,B4,STRCADC     BUFFER FULL
  
          SB7    B4-B3             SPACE REMAINING
          SB6    10 
          MX3    -6 
          LT     B2,B7,CADC20      SPACE EXISTS FOR STRING
  
          SB2    B7 
 CADC20   BSS    0                 DISASSEMBLE STRING 
          LX1    6
          BX6    -X3*X1            EXTRACT 1ST CHARACTER
          SA6    B3+B5
          SB3    B3+B1
          SB2    B2-B1
          SB6    B6-B1
          SX5    X6-76B 
          SX0    X6-74B 
          ZR     X5,CADC30         ASCII PREFIX FOUND 
          ZR     X0,CADC30         ASCII 74B PREFIX 
  
 CADC25   BSS    0
          GE     B0,B2,CADC50      STRING UNPACKED
          LT     B0,B6,CADC20      FINISH THIS WORD 
  
          SA1    A1+B1             GET NEXT WORD
          SB6    10 
          JP     CADC20            NEXT CHARACTER 
  
 CADC30   BSS    0
          GE     B0,B2,CADC50      END OF STRING
  
          SB3    B3-B1             RETAIN CURRENT POSITION
          LT     B0,B6,CADC35      NEXT CHARACTER 
  
          SA1    A1+B1
          SB6    10 
  
 CADC35   BSS    0
          LX1    6
          BX6    -X3*X1 
          SA6    B3+B5
          SB2    B2-B1
          SB6    B6-B1
          ZR     X0,CADC40         74B PREFIX 
          NZ     X6,CADC35A        CHECK .LT. 7633B 
  
          SX6    =1R^ 
          SA6    B3+B5
          SA4    DISCOL            63/64 DEFINED COLON
          BX6    X4 
          SB3    B3+B1
          SA6    B3+B5             STORE COLON
          SB3    B3+B1
          JP     CADC25            NEXT CHARACTER 
  
 CADC35A  BSS    0
          SX0    X6-33B 
          SB3    B3+B1
          NG     X0,CADC25         NEXT CHARACTER 
  
          MX6    0
          SA6    A6                CLEAR/SKIP .GT.7632B 
          SB3    B3-B1             CURRENT CHARACTER
          JP     CADC25            NEXT CHARACTER 
  
 CADC40   BSS    0
          SX0    X6-1B
          SX4    X6-4B
          SX5    X6-2B
          SX7    =1R@ 
          ZR     X0,CADC45         UNPACK AT SIGN 
  
          SX7    =1R^ 
          ZR     X5,CADC45         UNPACK CIRCUMFLEX
  
          SX0    X6-7 
          SA5    DISCOL            63/64 DEFINED COLON
          BX7    X5 
          ZR     X4,CADC45         UNPACK COLON 
          ZR     X0,CADC25         SKIP 7407B 
  
          BX7    X6                RESTORE CURRENT CHARACTER AND 74B
  
 CADC45   BSS    0
          SA7    B3+B5             STORE NEW CHARACTER
          SB3    B3+B1
          JP     CADC25            NEXT CHARACTER 
  
 CADC50   BSS    0                 UPDATE HEADER
          MX6    -N.SBCUR 
          SX0    B3                NEW TOTAL OF CHARACTERS
          BX2    -X6*X2 
          LX0    S.SBTOT-N.SBTOT+1
          BX7    X0+X2
          BX2    X0+X2
          SA7    A2                STORE UPDATED HEADER 
          JP     STRCADC           RETURN 
          TITLE  CSTRCCL - STRDTC - DELETE TRAILING CHARACTERS
**        STRDTC  -  DELETE TRAILING CHARACTERS                         002340
*                                                                       002350
*         STRDTC - DELETES TRAILING ZERO AND BLANK CHARACTERS 
*         STRDTC4- DELETES ONLY TRAILING ZERO CHARACTERS
*         STRDTC5- DELETES ONLY TRAILING BLANK CHARACTERS 
*         UPDATES BUFFER HEADER IN MEMORY TO REFLECT DELETIONS          002374
*                                                                       002380
*         ENTRY  A2  = SCATTER BUFFER HEADER ADDRESS                    002390
*                X2  = SCATTER BUFFER HEADER                            002400
*                B1  = 1                                                002410
*                                                                       002420
*         EXIT   B2 = NUMBER OF CHARACTERS REMAINING IN BUFFER          002430
*                B1  = 1                                                002440
*         X2  = UPDATED BUFFER HEADER                                   002444
*                                                                       002450
*         SAVES  A1 AND X1                                              002460
                                                                        002470
 STRDTC   SUBR   =                                                      002480
          SX5    1R                                                     002490
 DTC1     BSS                                                           002500
          MX0    0
 DTC1.5   BSS 
          MX7    59-S.SBTOT                                             002510
          BX7    -X7*X2                                                 002530
          AX7    S.SBTOT-N.SBTOT+1                                      002540
          SB7    X7          NUMBER CHARACTERS                          002550
          SB5    A2+B1       START OF SCATTER BUFFER                    002560
 DTC2     BSS                                                           002570
          SB7    B7-B1                                                  002580
          NG     B7,DTC3     IF NO MORE CHARACTERS                      002590
          SA4    B5+B7       FETCH LAST CHARACTER                       002600
          BX7    X0-X4                                                  002610
          ZR     X7,DTC2     IF EQUAL CONTINUE DELETING                 002620
                                                                        002630
          BX7    X5-X4                                                  002640
          NZ     X7,DTC3     UPDATE BUFFER HEADER AND EXIT
  
*         TEST FOR POSSIBLE COLON AT END OF LINE
  
          SA4    A4-B1       NEXT CHARACTER TO TEST 
          NZ     X4,DTC2     CHARACTER IS NOT A COLON 
  
                                                                        002670
 DTC3     BSS                                                           002680
          MX0    -N.SBCUR                                               002690
          SX7    B7+B1       NUMBER OF CHARACTERS LEFT                  002700
          BX2    -X0*X2                                                 002710
          LX7    S.SBTOT-N.SBTOT+1                                      002720
          SB2    B7+B1       NUMBER OF CHARACTERS                       002730
          BX6    X2+X7                                                  002740
          BX2    X2+X7                                                  002750
          SA6    A2          STORE UPDATED SCATTER BUFFER HEADER        002760
          JP     STRDTC                                                 002770
                                                                        002780
 STRDTC4  SUBR   =                                                      002790
          SA4    STRDTC4                                                002800
          BX6    X4                                                     002810
          SX5    B0          INDICATE ONLY DELETE ZEROS                 002820
          SA6    STRDTC      SET EXIT ADDRESS                           002830
          JP     DTC1                                                   002840
  
  
 STRDTC5  SUBR   =
          SA4    STRDTC5
          BX6    X4 
          SX5    1R 
          SA6    STRDTC      RETURN ADDRESS 
          SX0    1R          INDICATE DELETE ONLY BLANKS
          JP     DTC1.5 
  
  
          TITLE  CSTRCCL - STREVL - EVALUATE LITERAL
**        STREVL  -  EVALUATE LITERAL                                   002860
*                                                                       002870
*         EVALUATES WELL FORMED LITERALS - DOES NOT DETECT BAD LITERALS 002880
*         TO EVALUATE A LITERAL EACH SINGLE DOLLAR SIGN ($) IS REMOVED  002890
*         AND EACH DOUBLE DOLLAR ($$) THAT OCCURS WITHIN $ BRACKETS     002900
*         IS REDUCED TO ONE DOLLAR ($).                                 002910
*         NOTE THAT THE CHARACTER STRING MAY OR MAY NOT                 002920
*         BEGIN OR END WITH $.  THE FOLLOWING ARE EQUIVALENT.           002930
*         $ABC.XYZ$          ABC$.$XYZ                                  002940
*                                                                       002950
*         ENTRY  - LITERAL AT ANSSTR WITH NUMBER                        002960
*                  OF CHARACTERS AT ANSCHR                              002970
*                B1  = 1                                                002980
*                                                                       002990
*         EXIT   - ANSEVL = EVALUATED STRING                            003000
*                  ANSEVLC = NUMBER OF CHARACTERS IN ANSEVL 
*                B1  = 1                                                003020
*                                                                       003030
                                                                        003040
 STREVL   SUBR   =                                                      003050
          SA4    ANSCHR      NUMBER OF CHARACTERS                       003060
          SA1    ANSSTR                                                 003070
          SB2    X4          NUMBER OF CHARACTERS                       003080
          SA2    SCATX                                                  003090
          MX2    0           CLEAR HEADER                               003100
          RJ     STRUPS      UNPACK LITERAL INTO SCATX                  003110
                                                                        003120
          SA3    SCATX                                                  003130
          SB5    B0                                                     003140
          SB7    B0                                                     003150
          SB4    B0          CLEAR FLAG, (1=WITHIN $ BRACKETS)          003160
          AX3    S.SBTOT-N.SBTOT+1                                      003170
          SB6    A3+B1       SCATX+1   ADDR. FIRST CHARACTER            003180
          SB2    B0                                                     003190
          SB3    X3          TOTAL CHARACTERS IN LITERAL                003200
          SX0    1R$                                                    003210
 EVL1     BSS                                                           003220
          GE     B5,B3,EVL4  EXIT IF END OF LITERAL                     003230
          SA5    B5+B6       FETCH NEXT CHARACTER                       003240
          SB5    B5+B1                                                  003250
          BX4    X0-X5                                                  003260
          BX7    X5                                                     003270
          NE     B0,B4,EVL3  IF INSIDE $ BRACKETS                       003280
                                                                        003290
          EQ     B1,B2,EVL2  IF CHAR. IMMEDIATELY AFTER TRAILING $      003300
                                                                        003310
          SB4    1           ASSUME THIS IS $                           003320
          ZR     X4,EVL1     SKIP IF $                                  003330
                                                                        003340
          SB4    B0          RESET                                      003350
 EVL2     BSS                                                           003360
          SA7    B6+B7                                                  003370
          SB7    B7+B1                                                  003380
*         IF THIS CHARACTER IS THE CHARACTER FOLLOWING A                003390
*         DOLLAR ($) THAT WAS A TRAILING BRACKET, THEN IF               003400
*         THIS CHAR. IS A $ THEN THIS IS A DOUBLE ($$) AND              003410
*         WE ARE STILL WITHIN THE $ BRACKETS.                           003420
                                                                        003430
          NE     B1,B2,EVL1  IF NOT IMMEDIATELY AFTER  $                003440
          SB2    B0          CLEAR FLAG                                 003450
          NZ     X4,EVL1     IF THIS IS NOT A DOLLAR                    003460
          SB4    B1          FLAG, STILL WITHIN $ BRACKETS              003470
          JP     EVL1        GO EXAMINE NEXT CHARACTER                  003480
                                                                        003490
 EVL3     BSS                                                           003500
          NZ     X4,EVL2     ACCEPT CHAR. IF NOT $                      003510
                                                                        003520
          SB4    B0          CLEAR FLAG                                 003530
          SB2    B1          FLAG, TRAILING $ WAS LAST CHAR.            003540
          JP     EVL1        CONTINUE                                   003550
                                                                        003560
                                                                        003570
 EVL4     BSS                                                           003580
          SA1    ANSEVL                                                 003590
          SX7    B7          NUMBER CHARACTERS                          003600
          SA2    SCATX        SCATTER BUFFER ADDRESS                    003610
          SA7    ANSEVLC     STORE CHAR. COUNT OF EVALUATED LIT.        003620
          SX2    B7          NUMBER CHARACTERS                          003630
          LX2    S.SBTOT-N.SBTOT+1                                      003640
          RJ     STRPKS                                                 003650
          JP     STREVL      EXIT                                       003660
          TITLE  CSTRCCL - STREVN - EVALUATE NUMERIC
**        STREVN  -  EVALUATE NUMERIC                                   003680
*                                                                       003690
*         EVALUATE UP TO 10 NUMERIC CHARACTERS.                         003700
*         THE NUMBER IS ASSUMED TO BE DECIMAL.  THE LAST                003710
*         CHARACTER MAY BE A POST RADIX OF EITHER  B  OR  D.            003720
*         AN ERROR IS DETECTED IF ANY OTHER CHARACTER IS NOT            003730
*         A NUMERIC.  AN ERROR IS ALSO DETECTED IF THE STRING           003740
*         CONTAINS AN 8 OR 9 AND A POST RADIX OF B IS SPECIFIED.        003750
*                                                                       003760
*         ENTRY  X1  = STRING, LEFT JUSTIFIED, ZERO FILL                003770
*                B1  = 1                                                003780
*                                                                       003790
*         EXIT   ANSEVN = BINARY VALUE -RIGHT JUSTIFIED - ZERO FILL 
*                X6     = BINARY VALUE -RIGHT JUSTIFIED - ZERO FILL 
*                X5 = 0, VALUE OK, =1, ERROR IN NUMERIC                 003820
*                B1  = 1                                                003830
*                                                                       003840
                                                                        003850
 STREVN   SUBR   =                                                      003860
          SB2    B1+B1       B2=2                                       003870
          SB5    B0          CLEAR 8/9 DIGIT FLAG                       003880
          MX7    0           CLEAR REGISTER FOR OCTAL                   003890
          MX6    0           CLEAR REGISTER FOR DECIMAL                 003900
          MX4    -6                                                     003910
          LX1    6           SHIFT TO FIRST DIGIT                       003920
          SB6    10          MAXIMUM CHARACTERS                         003930
          SB3    1R0                                                    003940
          SB4    1R9+1                                                  003950
 EVN1     BSS                                                           003960
          ZR     X1,EVN2     IF COMPLETE                                003970
          BX0    -X4*X1      EXTRACT DIGIT                              003980
          BX1    X1*X4       CLEAR DIGIT                                003990
          SB7    X0                                                     004000
          LX1    6           SHIFT TO NEXT DIGIT                        004010
          SX0    X0-1R0      CONVERT TO BINARY NUMBER                   004020
          SX3    MSG300                                                 004030
          LT     B7,B3,EVN3  IF ALPHA CHARACTER                         004040
          GE     B7,B4,EVN4  IF NOT NUMERIC                             004050
                                                                        004060
*         MULTIPLY PREVIOUS DIGITS                                      004070
                                                                        004080
          LX2    X6,B2       *4                                         004090
          IX6    X2+X6       *4 + 1 = *5                                004100
          LX6    1           *(4 + 1) * 2 =  *10                        004110
          LX7    3           OCTAL,  *8                                 004120
          IX6    X0+X6       ADD COURENT DIGIT                          004130
          IX7    X0+X7       ADD CURRENT DIGIT                          004140
          AX0    3                                                      004150
          SB5    X0+B5       B5 NON-ZERO IF 8 OR 9                      004160
          NZ     X1,EVN1     IF MORE DIGITS                             004170
                                                                        004180
*         SINCE NO POST RADIX ENCOUNTERED, STORE DECIMAL VALUE          004190
                                                                        004200
 EVN2     BSS                                                           004210
          MX5    0           INDICATE NUMERIC WAS VALID                 004220
          SA6    ANSEVN      STORE DECIMAL OR OCTAL VALUE               004230
          JP     STREVN      EXIT                                       004240
                                                                        004250
 EVN3     BSS                                                           004260
                                                                        004270
*         ALPHA CHARACTER ENCOUNTERED.  TO BE A POST RADIX IT MUST      004280
*         BE THE LAST CHARACTER IN THE STRING AND IT MUST BE            004290
*         EITHER  D  OR  B.                                             004300
                                                                        004310
          SB3    1RB                                                    004320
          SB4    1RD                                                    004330
          NZ     X1,EVN4     IF NOT LAST DIGIT                          004340
          EQ     B4,B7,EVN2  EXIT IF POST RADIX OF D                    004350
          NE     B3,B7,EVN4  IF NOT B                                   004370
          BX6    X7          PREPARE TO STORE OCTAL VALUE               004380
          EQ     B0,B5,EVN2  OK IF NO 8/9 DIGITS                        004390
                                                                        004400
*         POST RADIX OF B AND 8/9 DIGITS CONFLICTS                      004410
                                                                        004420
          SX3    MSG302                                                 004430
                                                                        004440
                                                                        004450
*                X3  = MESSAGE CODE                                     004460
                                                                        004470
 EVN4     BSS                                                           004480
          SA1    IACIDP 
          SX0    X1-2 
          ZR     X0,EVN10    SKIP MSG DURING SCREEN DIALOGUES 
  
          SA1    PBCOND 
          NZ     X1,EVN10    IF WITHIN PROC BODY CONDITIONAL
  
          RJ     STRMSG                                                 004490
                                                                        004500
 EVN10    BSS    0
          SX5    1           ERROR FLAG                                 004510
          JP     STREVN      EXIT                                       004520
          TITLE  CSTRCCL - STRFZB - FIND ZERO BYTE
**        STRFZB  -  FIND ZERO BYTE                                     004540
*                                                                       004550
*         FIND THE ZERO BYTE AND RETURNS THE NUMBER OF CHARACTER        004560
*         UP TO THAT BYTE.                                              004570
*                                                                       004580
*         ENTRY  A1  = ADDRESS OF FIRST WORD OF LINE                    004590
*                X1  = FIRST WORD OF LINE                               004600
*                B1  = 1                                                004610
*                B2  = MAXIMUM NUMBER OF CHARACTERS                     004620
*                                                                       004630
*         SAVES  A1,A2   X1,X2                                          004640
*                                                                       004650
*         EXIT   B2  = NUMBER OF CHARACTERS 
*                B1  = 1                                                004670
*                B3  = NUMBER OF WORDS                                  004680
*                A1  = ADDRESS OF FIRST WORD OF STRING                  004690
*                                                                       004700
                                                                        004710
 STRFZB   SUBR   =                                                      004720
          MX6    6
          MX0    -12                                                    004740
          BX5    X1                                                     004770
          SB7    B2                                                     004780
          SB2    B0+         INITIALIZE CHARACTER COUNT 
          SB3    B0+         INITIALIZE WORD COUNT
          NG     X5,FZB1     IF POSSIBLE WORD OF SEMI-COLONS
  
          ZR     X5,STRFZB   IF NO CHARACTERS 
  
 FZB1     BSS                                                           004800
          SB3    B3+B1                                                  004820
          SB2    B2+10                                                  004830
          BX7    -X0*X5 
          ZR     X7,FZB1.5   IF ZERO BYTE TERMINATOR
  
          GE     B2,B7,FZB2  IF MAXIMUM CHAR. REACHED                   004850
  
          SA5    A1+B3       FETCH NEXT TEN CHARACTERS
          JP     FZB1        CHECK NEXT WORD FOR ZERO BYTE
  
  
*         ELIMINATE ALL ZERO FILLED BYTES FROM CHARACTER COUNT
  
 FZB1.5   BSS    0
          LX6    6           SHIFT MASK TO NEXT CHARACTER 
          BX7    X5*X6
          NZ     X7,STRFZB   6 BITS NON-ZERO FOUND IN WORD
  
          SB2    B2-B1
          PL     X6,FZB1.5   IF NOT DONE WITH THIS WORD 
  
          SA5    A5-B1
          SB3    B3-B1
          JP     FZB1.5      CHECK THE PREVIOUS WORD
                                                                        004880
 FZB2     BSS                                                           004890
          SB2    B7          NUMBER OF CHARACTERS                       004900
          JP     STRFZB                                                 004910
          TITLE  CSTRCCL - STRMGA - ABORT MESSAGE PROCESSOR.
**        STRMGA - PROCESS ABORT MESSAGES.
* 
*         MODIFIES *MSGOPT* TO FORCE SYSTEM DAYFILE TO BE INCLUDED AS 
*         A DESTINATION FOR THE MESSAGE AND CALLS *STRMSG* TO ASSEMBLE
*         THE MESSAGE FROM UP TO THREE STRINGS AND ISSUE IT.
*         NO PORTION OF THE MESSAGE MAY EXCEED 80 CHARACTERS. 
*         USEFUL FOR NOS AND NOS/BE ONLY, NO-OP FOR SCOPE2. 
* 
*         ENTRY  X3 = CONTROL WORD. 
*                     17 - 00 = ADDRESS OF FIRST PART OF MESSAGE. 
*                     35 - 18 = ADDRESS OF SECOND PART OF MESSAGE.
*                             = 0, MESSAGE HAS ONLY ONE PART. 
*                     53 - 36 = ADDRESS OF THIRD PART OF MESSAGE. 
*                             = 0, MESSAGE HAS ONLY TWO PARTS.
*                *MSGOPT* = DESTINATION OF THE MESSAGE. 
*                         *MOSJDT* OR *MOJDT*, SYSTEM AND JOB DAYFILES
*                                              AND TERMINAL.
*                         *MOSJD* OR *MOJD*, SYSTEM AND JOB DAYFILES. 
* 
*         EXIT   MESSAGE ISSUED, MSGOPT RESET TO NOMINAL VALUE. 
* 
*         USES   X - 1, 7.
*                A - 1, 7.
* 
*         CALLS  STRMSG.
  
 STRMGA   SUBR               ENTRY/EXIT 
  
 OSNOSBE  IFNE   HOST,SC2 
          SA1    MSGOPT 
          SX7    MOSJDT 
          SX1    X1-MOSJD 
          NG     X1,MGA1     IF MESSAGE OPTION INCLUDES TERMINAL
  
          SX7    MOSJD
 MGA1     BSS    0
          SA7    A1 
 OSNOSBE  ENDIF 
  
          RJ     STRMSG      ASSEMBLE AND ISSUE MESSAGE 
  
          JP     STRMGAX
          TITLE  CSTRCCL - STRMGU - UNPACKED ABORT MESSAGE PROCESSOR. 
**        STRMGU - PROCESS UNPACKED ABORT MESSAGES. 
* 
*         MODIFIES *MSGOPT* TO FORCE SYSTEM DAYFILE TO BE INCLUDED AS 
*         A DESTINATION FOR THE MESSAGE AND CALLS *STRMSU* TO ISSUE IT. 
*         USEFUL FOR NOS AND NOS/BE ONLY, NO-OP FOR SCOPE2. 
* 
*         ENTRY  *SCATX* = UNPACKED MESSAGE TO BE ISSUED. 
*                *MSGOPT* = DESTINATION OF THE MESSAGE. 
*                         *MOSJDT* OR *MOJDT*, SYSTEM AND JOB DAYFILES
*                                              AND TERMINAL.
*                         *MOSJD* OR *MOJD*, SYSTEM AND JOB DAYFILES. 
* 
*         EXIT   MESSAGE ISSUED, *MSGOPT* RESET TO NOMINAL VALUE. 
* 
*         USES   X - 1, 7.
*                A - 1, 7.
* 
*         CALLS  STRMSU.
  
 STRMGU   SUBR               ENTRY/EXIT 
  
 OSNOSBE  IFNE   HOST,SC2 
          SA1    MSGOPT 
          SX7    MOSJDT 
          SX1    X1-MOSJD 
          NG     X1,MGU1     IF MESSAGE OPTION INCLUDES TERMINAL
  
          SX7    MOSJD
 MGU1     BSS    0
          SA7    A1 
 OSNOSBE  ENDIF 
  
          RJ     STRMSU      ISSUED UNPACKED MESSAGE
  
          JP     STRMGUX
          TITLE  CSTRCCL - STRMSG - MESSAGE PROCESSOR 
**        STRMSG - PROCESS MESSAGES.
* 
*         ASSEMBLES A MESSAGE FROM UP TO THREE STRINGS, CALLS *STRMSU*
*         TO ISSUE THE MESSAGE TO DESTINATIONS SPECIFIED BY *MSGOPT*. 
*         NO PORTION OF THE MESSAGE MAY EXCEED 80 CHARACTERS. 
* 
*         ENTRY  X3 = CONTROL WORD. 
*                     17 - 00 = ADDRESS OF FIRST PART OF MESSAGE. 
*                     35 - 18 = ADDRESS OF SECOND PART OF MESSAGE.
*                             = 0, MESSAGE HAS ONLY ONE PART. 
*                     53 - 36 = ADDRESS OF THIRD PART OF MESSAGE. 
*                             = 0, MESSAGE HAS ONLY TWO PARTS.
*                *MSGOPT* = DESTINATION OF THE MESSAGE FOR NOS, NOS/BE. 
*                          *MOSJDT*, SYSTEM, JOB DAYFILES AND TERMINAL. 
*                          *MOJDT*,  JOB DAYFILE AND TERMINAL.
*                          *MOSJD*,  SYSTEM AND JOB DAYFILES. 
*                          *MOJD*,   JOB DAYFILE ONLY.
* 
*         EXIT   MESSAGE ISSUED, MSGOPT RESET TO NOMINAL VALUE. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  STRDTC4, STRFZB, STRMSU, STRUPS. 
                                                                        005090
 STRMSG   SUBR   =                                                      005100
          MX0    6                                                      005110
          MX7    0                                                      005120
          MX6    -12                                                    005130
          BX5    -X0*X3      CLEAR UPPER BITS                           005140
          SA7    SCATX                                                  005150
                                                                        005160
 MSG1     BSS                                                           005170
          MX7    -18                                                    005180
          BX6    X5                                                     005190
          BX7    -X7*X5      EXTRACT NEXT STRING ADDRESS                005200
          AX6    18                                                     005210
          SA6    MSGPT                                                  005230
          SA1    X7          ADDRESS OF STRING                          005240
          SB2    80                                                     005250
          RJ     STRFZB                                                 005260
  
          SA2    SCATX                                                  005270
          RJ     STRUPS                                                 005280
  
          SA2    SCATX                                                  005290
          RJ     STRDTC4     DELETE ZERO BYTES, NOT BLANKS              005300
  
          SA5    MSGPT                                                  005310
          NZ     X5,MSG1     IF MORE STRINGS TO MERGE                   005320
                                                                        005330
          RJ     STRMSU      ISSUE UNPACKED MESSAGE IN SCATX
  
          JP     STRMSGX     EXIT 
  
 MSGPT    BSS    1           TEMPORARY STORAGE FOR CONTROL WORD 
          TITLE  CSTRCCL - STRMSU - UNPACKED MESSAGE PROCESSOR. 
**        STRMSU - PROCESS UNPACKED MESSAGES. 
* 
*         ISSUES UNPACKED MESSAGE IN *SCATX*.  FOR NOS AND NOS/BE, THE
*         MESSAGE IS ISSUED TO THE DESTINATIONS SPECIFIED BY *MSGOPT*.
* 
*         ENTRY  *SCATX* = UNPACKED MESSAGE TO BE ISSUED. 
*                *MSGOPT* = DESTINATION OF THE MESSAGE FOR NOS, NOS/BE. 
*                          *MOSJDT*, SYSTEM, JOB DAYFILES AND TERMINAL. 
*                          *MOJDT*,  JOB DAYFILE AND TERMINAL.
*                          *MOSJD*,  SYSTEM AND JOB DAYFILES. 
*                          *MOJD*,   JOB DAYFILE ONLY.
* 
*         EXIT   MESSAGE ISSUED, MSGOPT RESET TO NOMINAL VALUE. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 5, 6, 7. 
* 
*         CALLS  DCI, STRPKS. 
* 
*         MACROS MESSAGE. 
  
 STRMSU   SUBR               ENTRY/EXIT 
  
 OSNOSBE  IFNE   HOST,SC2 
          RJ     DCI         DISPLAY COMMAND IMAGE IF NOT YET DISPLAYED 
  
 OSNOSBE  ENDIF 
  
          SB5    9                                                      005340
          MX7    0                                                      005350
          SB7    B0                                                     005360
          SB6    MSGBUF                                                 005370
 MSU1     BSS    0
          SA7    B6+B7       ZERO WORD OF MSGBUF                        005390
          SB7    B7+B1                                                  005400
          LT     B7,B5,MSU1  IF MORE WORDS TO ZERO
                                                                        005420
          SA1    MSGBUF                                                 005430
          SA2    SCATX                                                  005440
 OSNOSBE  IFEQ   HOST,NOSBE 
  
*         DAYFILE MESSAGES ON NOSBE ARE PRINTED IN TWO
*         LINES IF THE MESSAGE IS MORE THAN 40 CHARACTERS.
*         THIS MAKES IT A LITTLE DIFFICULT TO READ THE MESSAGE. 
*         STRMSG PRINTS THREE TYPES OF MESSAGES.  THE CONTINUATION
*         CARDS OF A CONTINUED CCL STATEMENT, SKIPPED CONTROL CARDS 
*         (PREFIXED WITH TWO PERIODS ON NOS/NOSBE), DISPLAY VERB
*         OUTPUT AND THE CCL MESSAGES WHICH 
*         BEGIN WITH TWO BLANKS FOLLOWED BY THE CCL MESSAGE CODE. 
* 
*         ON NOSBE DO THE FOLLOWING:  
*                1.  IF MSG. HAS 41 TO 78 CHARACTERS DO 
*                2.   IF THE MSG. BEGINS WITH TWO PERIODS THEN INSERT 
*                     TWO BLANKS AFTER CHARACTER 40 SO
*                     THAT THE SECOND LINE IS INDENTED. 
*                3.   IF THE MSG. IS A CCL MESSAGE SEARCH BACK TO 
*                     FIND THE LAST COMPLETE WORD AND INSERT BLANKS 
*                     TO FORCE THE WHOLE WORD INTO THE SECOND LINE
  
          MX0    -36
          BX0    -X0*X2 
          AX0    18 
          SX7    X0-41
          SX6    X0-79
          NG     X7,MSU6     IF LESS THAN 41 CHARACTERS 
  
          PL     X6,MSU6     IF GREATER THAN 78 CHARACTERS
  
          SA3    SCATX+1
          SA4    SCATX+2
          SB7    2
          SX3    X3-1R. 
          SX4    X4-1R. 
          BX3    X3+X4
          ZR     X3,MSU3     IF MESSAGE PREFIXED WITH  *..* 
  
          SA3    SCATX+1
          SA4    SCATX+2
          SA5    SCATX+3
          SX3    X3-1R
          SX4    X4-1R
          SX5    X5-1RC 
          NZ     X3,MSU6     IF FIRST CHARACTER NOT BLANK 
  
          NZ     X4,MSU6     IF SECOND CHARACTER NOT BLANK
  
          NZ     X5,MSU6     IF THIRD CHARACTER NOT *C* 
  
          SA3    SCATX+4
          SA4    SCATX+5
          SA5    SCATX+9
          SX3    X3-1RC 
          SX4    X4-1RL 
          SX5    X5-1R- 
          NZ     X3,MSU6     IF FOURTH CHARACTER NOT *C*
  
          NZ     X4,MSU6     IF FIFTH CHARACTER NOT *L* 
  
          NZ     X5,MSU6     IF NINTH CHARACTER NOT *-* 
  
          SA3    SCATX+10 
          SX3    X3-1R
          NZ     X3,MSU6     IF TENTH CHARACTER NOT BLANK 
  
*         THIS IS A CCL MESSAGE.  FIND THE LAST BLANK BEFORE CHARACTER
*         41 AND INSERT ENOUGH BLANKS (LIMIT OF TEN) TO PREVENT A WORD
*         FROM BEING SPLIT BETWEEN THE TWO DAYFILE LINES.  ALSO INDENT
*         THE SECOND LINE.
  
          SB6    10 
 MSU2     BSS    0
          SA5    SCATX+30+B6
          SB6    B6-B1
          SX7    X5-1R
          ZR     X7,MSU3     IF BLANK CHARACTER FOUND 
  
          SB7    B7+B1
          LT     B0,B6,MSU2  IF TEN CHARACTERS NOT YET EXAMINED 
  
*         THE WORD WHICH WILL BE SPLIT IS GREATER THAN 10 CHARACTERS. 
*         SIMPLY INSERT TWO BLANKS TO INDENT THE SECOND LINE
  
          SB7    2
  
  
*                X0  = TOTAL CHARACTERS IN SCATX
*                B7  = NUMBER OF BLANKS TO BE ADDED 
  
 MSU3     BSS    0
          SX6    X0+B7
          SA5    SCATX+1+X0  FETCH LAST CHARACTER OF MESSAGE
          SX7    X6-81
          SB6    X6-40       NUMBER OF CHARACTERS TO MOVE 
          NG     X7,MSU4     IF ALL BLANKS MAY BE INSERTED
  
          SB7    2           INSERT ONLY TWO SO NO OVERFLOW OCCURS
          JP     MSU3        RECOMPUTE CHARACTERS TO MOVE 
  
 MSU4     BSS    0
          SA5    A5-1        FETCH CHARACTER TO MOVE
          BX7    X5 
          SB6    B6-B1
          SA7    A5+B7       MOVE CHARACTER DOWNWARD TO MAKE ROOM FOR BL
          LT     B0,B6,MSU4  IF MORE CHARACTERS TO MOVE 
  
          SX6    X0+B7
          LX6    18 
          SA6    SCATX       RESET TOTAL CHARACTER COUNT
          BX2    X6 
          SX7    1R 
          SA7    SCATX+42 
 MSU5     BSS    0
          SB7    B7-B1
          SA7    A7-B1
          LT     B1,B7,MSU5  IF MORE BLANKS TO INSERT 
  
 MSU6     BSS    0
  
 OSNOSBE  ENDIF 
          RJ     STRPKS      PACK MESSAGE INTO MSGBUF                   005450
                                                                        005460
 OSNOSBE  IFNE   HOST,SC2 
  
*         MESSAGE OPTIONS FOR THE NOS AND NOSBE SYSTEMS ARE 
*         LISTED IN THE COMMON DECK AREA OF CCL.
  
          SA3    MSGOPT 
          SX0    X3-MOJD
          NZ     X0,MSU7     IF NOT JOB DAYFILE ONLY OPTION 
  
          MESSAGE MSGBUF,7,RECALL 
          JP     MSU10       RESET *MSGOPT* AND EXIT
  
 MSU7     BSS    0
          SX0    X3-MOSJD 
          NZ     X0,MSU8     IF NOT SYSTEM, JOB DAYFILE OPTION
  
          MESSAGE MSGBUF,6,RECALL 
          JP     MSU10       RESET *MSGOPT* AND EXIT
  
 MSU8     BSS    0
          SX0    X3-MOSJDT
          NZ     X0,MSU9     IF NOT SYSTEM, JOB AND TERMINAL OPTION 
  
          MESSAGE MSGBUF,0,RECALL 
          JP     MSU10       RESET *MSGOPT* AND EXIT
  
 MSU9     BSS    0
          MESSAGE MSGBUF,3,RECALL  MESSAGE TO JOB DAYFILE AND TERMINAL
  
 OSNOSBE  ELSE
          MESSAGE  MSGBUF,,RECALL 
                                                                        005480
 OSNOSBE  ENDIF 
  
 MSU10    BSS    0
          SX7    MOJDT
          SA7    MSGOPT      RESET OPTION TO NOMINAL VALUE
          JP     STRMSUX     EXIT 
          TITLE  CSTRCCL - STRPKS - PACK STRING 
**        STRPKS  -  PACK STRING                                        005530
*                                                                       005540
*         PACK THE CHARACTERS IN THE SCATTER BUFFER INTO A LINE         005550
*         WITH 10 CHARACTERS PER WORD.                                  005560
*                                                                       005570
*         ENTRY  A1  = ADDRESS OF DESTINATION                           005580
*                A2  = SCATTER BUFFER HEADER ADDRESS                    005590
*                X2  = SCATTER BUFFER HEADER (SBTOT=NUMBER OF CHARS)
*                B1  = 1                                                005610
*                                                                       005620
*         EXIT   B2  = NUMBER OF CHARACTERS PACKED                      005630
*                B3  = NUMBER OF WORDS PACKED                           005640
*                B1  = 1                                                005650
*                A1  = STRING ADDRESS(SAVED FROM INPUT)                 005660
*                                                                       005670
                                                                        005680
 STRPKS   SUBR   =                                                      005690
          MX7    0                                                      005700
          AX2    S.SBTOT-N.SBTOT+1                                      005710
          SB3    B0          CLEAR, RELATIVE WORD IN DESTINATION        005720
          SB7    X2          TOTAL CHARACTERS TO BE PACKED              005730
          SB5    V.SBSIZ
          SB2    X2          CHAR. PACKED                               005750
          MX0    -6                                                     005760
          SA2    A2+B1       FIRST CHARACTER OF BUFFER                  005770
          SB6    60                                                     005790
          GE     B5,B7,PKS1  STRING WILL FIT BUFFER 
          SB7    B5          TRUNCATE STRING
 PKS1     BSS                                                           005800
          GE     B0,B7,PKS2                                             005810
          BX2    -X0*X2                                                 005820
          SB6    B6-6                                                   005830
          LX2    X2,B6                                                  005840
          BX7    X2+X7                                                  005850
          SA2    A2+B1                                                  005860
          SB7    B7-B1                                                  005870
          LT     B0,B6,PKS1                                             005880
                                                                        005890
*         STORE ASSEMBLED WORD OF LINE                                  005900
                                                                        005910
 PKS2     BSS                                                           005920
          SA7    A1+B3       STORE TEN CHARACTERS                       005930
          SB3    B3+B1                                                  005940
          MX7    0           CLEAR ASSEMBLY REGISTER                    005950
          SB6    60                                                     005960
          LT     B0,B7,PKS1                                             005970
                                                                        005980
          SB6    V.SBSIZ/10                                             005990
          MX6    0                                                      006000
          GE     B3,B6,STRPKS  EXIT IF MAXIMUM LENGTH                   006010
          SA6    A7+B1       ENSURE ZERO BYTE                           006020
          JP     STRPKS                                                 006030
                                                                        006040
  
 STRPK12  TITLE  PACK 12 BIT CHARACTERS 
**        STRPK12 - PACK 12 BIT CHARACTERS
* 
*         PACK THE RIGHT JUSTIFIED 12 BIT CHARACTERS FROM 
*         THE SCATTER BUFFER INTO A LINE - 5 CHARACTERS 
*         PER WORD.  PREFIX THE STRING WITH A 0007B 
*         (TRANSPARENT MODE) CONTROL BYTE.  ENSURE THAT A 
*         ZERO BYTE FOLLOWS.
* 
*         ENTRY 
* 
*         A1 = ADDRESS OF DESTINATION 
*         A2 = SCATTER BUFFER HEADER ADDRESS
*         X2 = SCATTER BUFFER HEADER (SBTOT = NUMBER OF CHARACTERS) 
*         B1 = 1
* 
*         EXIT
* 
*         B2 = NUMBER OF CHARACTERS PACKED
*         B3 = NUMBER OF WORDS PACKED 
*         B1 = 1
*         A1 = STRING ADDRESS SAVED 
* 
* 
 STRPK12  BSSZ   1                 ENTRY/EXIT 
 OSSC2    IFEQ   HOST,SC2 
          RJ     STRPKS            PACK 6 BIT CHARACTERS
          JP     STRPK12           RETURN - IF NOT NBE
 OSSC2    ELSE
          SA3    IACIDP            CHECK DIALOGUE 
          NZ     X3,PK010          PACK 12 BIT STRINGS
  
          RJ     STRPKS            PACK 6 BIT STRINGS 
          JP     STRPK12           RETURN - BATCH MODE
  
 PK010    BSS    0
 SDOVL    IFNE   IP.SDO,0 
          SA3    SDMODE            CHECK FOR SCREEN MODE
          NZ     X3,PK020          PACK 12BIT CHARACTERS - SCREEN MODE
  
          RJ     STRPKS            PACK 6BIT CHARACTERS IN LINE MODE
          JP     STRPK12           RETURN 
  
 PK020    BSS    0
 SDOVL    ENDIF 
  
          MX7    0                 ASSEMBLY REGISTER
          AX2    S.SBTOT-N.SBTOT+1
          SB3    B0                DESTINATION RELATIVE WORD
          SB7    X2                TOTAL CHARACTERS 
          SB5    V.SBSIZ
          SB2    X2 
          MX0    -12
          SA2    A2+B1             1ST CHARACTER
          SB6    60 
          GE     B5,B7,PK100       START PACKING
  
          SB7    B5 
  
 PK100    BSS    0
          GE     B0,B7,PK200       PACKING COMPLETE 
          BX2    -X0*X2 
          SB6    B6-12
          LX2    X2,B6
          BX7    X2+X7
          SA2    A2+B1
          SB7    B7-B1
          LT     B0,B6,PK100       KEEP PACKING 
  
 PK200    BSS    0
          SA7    A1+B3             STORE 5 CHARACTERS 
          SB3    B3+B1
          MX7    0
          SB6    60 
          LT     B0,B7,PK100       NEXT WORD
  
          SA7    A7+B1             ZERO BYTE
          JP     STRPK12           RETURN 
  
 OSSC2    ENDIF 
  
 STRSBS   TITLE  SKIP BLANK SEPARATORS. 
**        STRSBS  -  SKIP BLANK SEPARATORS. 
* 
*         STRSBS CHECKS THE SEPARATOR IN *ANSSEP* FOR A BLANK, AND IF 
*         IT IS CALLS *STRANS* TO LOCATE A NON-BLANK SEPARATOR. 
* 
*         ENTRY  (A2) = ADDRESS OF SCATTER BUFFER IN USE. 
*                (X2) = SCATTER BUFFER HEADER.
*                (ANSSEP) = CURRENT SEPARATOR.
* 
*         EXIT   (X1) = THE NON-BLANK SEPARATOR FOUND (ALSO IN ANSSEP). 
*                (X2) = UPDATED SCATTER BUFFER HEADER.
*                (X4) = ZERO IF THE ORIGINAL SEPARATOR WAS NOT
*                       BLANK OR IF NO STRING WAS ENCOUNTERED 
*                       BEFORE A NON-BLANK SEPARATOR WAS FOUND, 
*                       OTHERWISE THE LENGTH OF THE STRING. 
*                (A2) = SCATTER BUFFER ADDRESS. 
*                (ANSSTR) = THE NEXT STRING IF NO NON-BLANK SEPARATOR 
*                           FOUND BEFORE THE STRING WAS ENCOUNTERED.
* 
*         USES   X - 1, 4, 6. 
*                A - 1, 4, 6. 
* 
*         CALLS  STRANS.
  
  
 STRSBS   SUBR               ENTRY/EXIT 
          SA1    ANSSEP      CHECK THE CURRENT SEPARATOR
          SX4    0           PRESET FOR NO STRING FOUND 
          SX6    X1-1R
          NZ     X6,STRSBSX  IF SEPARATOR IS NOT BLANK
  
          SA1    ANSMDE      SAVE THE ORIGINAL SEPARATOR MODE 
          BX6    X1 
          SA6    STRSBSA
          AX6    59          BLANKS NOT SEPARATORS HERE 
          SA6    ANSMDE 
          RJ     =XSTRANS    FIND THE NEXT SEPARATOR
  
          SA1    STRSBSA     RESTORE ORIGINAL SEPARATOR MODE
          SA4    ANSCHR 
          BX6    X1 
          SA1    ANSSEP 
          SA6    ANSMDE 
          JP     STRSBSX     RETURN 
  
 STRSBSA  BSS    1           SEPARATOR MODE STORAGE 
 STRTASC  TITLE  TRANSLATE ASCII STRING 
**        STRTASC  - TRANSLATE ASCCI STRING 
* 
*         STRTASC IS SIMILAR TO STRUPS.  A STRING IS UNPACKED 
*         FROM A LINE TO A SCATTER BUFFER.  STRTASC HAS ADDED 
*         CAPABILITIES.  STRTASC WILL TRUNCATE THE STRING IN
*         THE BUFFER.  THE CALL TO STRTASC WILL SPECIFY (B3)
*         THE TOTAL NUBER OF DISPLAYABLE 12 BIT CHARACTERS
*         (EXCLUDING CONTROL BYTES).  DURING THE TRANSFER,
*         STRTASC COUNTS A 6 BIT CHARACTER AS 1, A 12 BIT 
*         CHARACTER IS ALSO A 1.  WHEN B3 IS EXHAUSTED, STRTASC 
*         TERMINATES UNPACKING OF THE STRING.  STRTASC CONVERTS 
*         EACH CHARACTER IT UNPACKS TO A 8/12 BIT CHARACTER.  THE 
*         UNPACKED STRING IS STORED IN THE SCATTER BUFFER AS 12 
*         BIT RIGHT-JUSTIFIED, ZERO FILLED CHARACTERS.  STRPK12 
*         MAY THEN BE USED TO PACK THE STRING.
* 
* 
*         ENTRY 
* 
*         A1 = ADDRESS OF 1ST WORD IN STRING
*         X1 = 1ST WORD OF 6/12 
*         A2 = ADDRESS OF SCATTER BUFFER HEADER 
*         X2 = SCATTER BUFFER HEADER
*         B1 = 1
*         B2 = TOTAL 6 BIT BYTES IN STRING
*         B3 = ZERO - IGNORE TRUNCATION 
*            = NON-ZERO - COUNT FOR TRUNCATION
* 
*         SDTACN = TOTAL NUMBER OF CHARACTERS TO BE DISPLAYED 
* 
*         EXIT
* 
*         X2 = UPDATED SCATTER BUFFER HEADER
*         A2 = SCATTER BUFFER HEADER ADDRESS
*         B2 = TOTAL 6 BIT BYTES IN BUFFER
*         B3 = TOTAL NUBER OF UNPACKED 12 BIT CHARACTERS
* 
*         SDTACN = SAME AS B3 
* 
* 
 STRTASC  BSSZ   1                 ENTRY/EXIT 
 OSSC2    IFEQ   HOST,SC2 
          RJ     STRUPS            DO NOT CONVERT 6 BIT STRINGS 
          JP     STRTASC           RETURN - IF NOT NBE
 OSSC2    ELSE
          SA3    IACIDP 
          NZ     X3,TASC0          CONVERT INTERACTIVE DIALOGUE 
  
          RJ     STRUPS            DO NOT CONVERT BATCH MODE
          JP     STRTASC           RETURN - BATCH MODE
  
 TASC0    BSS    0
 SDOVL    IFEQ   IP.SDO,0 
          SB3    B0 
 SDOVL    ELSE
          SA3    SDMODE            CHECK FOR SCREEN MODE
          NZ     X3,TASC00         CONVERT CHARACTERS IN SCREEN MODE
  
          RJ     STRUPS            DO NOT CONVERT LINE MODE DIALOGUE
          JP     STRTASC           RETURN 
  
 TASC00   BSS    0
 SDOVL    ENDIF 
  
          SB1    1
          NZ     X2,TASC10         PRESERVE PREVIOUS 12 BIT COUNT 
  
          MX7    0
          SA7    SDTACN            CLEAR COUNT
 OSNOS    IFEQ   HOST,NOS 
          SX6    7B 
          SA6    A2+B1             STORE CONTROL BYTE 
          SB6    B1 
 OSNOS    ELSE
          SB6    B0 
 OSNOS    ENDIF 
          JP     TASC20            START UNPACKING
  
 TASC10   BSS    0
          EX0    X2,SBCUR 
          SB6    X0 
  
 TASC20   BSS    0
          SB7    V.SBSIZ
          EQ     B3,B0,TASC30      LIMIT STRING TO SIZE OF BUFFER 
          GT     B3,B7,TASC30      LIMIT STRING TO SIZE OF BUFFER 
  
          SB7    B3                TRUNCATION COUNT 
  
 TASC30   BSS    0
          SA3    SDTACN 
          SB3    X3                PREVIOUS 12 BIT CHARACTERS IN BUFFER 
          SB5    10 
          MX7    -6 
  
 TASC50   BSS    0                 NEXT CHARACTER 
          EQ     B7,B0,TASC60      SKIP TRUNCATION CHECK
          LE     B7,B3,TASC300     STOP UNPACKING - UPDATE HEADER 
  
 TASC60   BSS    0
          LE     B2,B0,TASC300     END OF STRING - UPDATE HEADER
  
          LX1    6
          BX6    -X7*X1 
          SX5    X6-76B 
          SX0    X6-74B 
          SB5    B5-B1
          SB2    B2-B1
          SB3    B3+B1
          SB6    B6+B1
          GE     B0,B2,TASC80      END OF STRING - CONVERT CHARACTER
          LT     B0,B5,TASC75      FINISH WORD
  
          SA1    A1+B1
          SB5    10 
  
 TASC75   BSS    0
          ZR     X5,TASC100        ASCII 76B BYTE 
          ZR     X0,TASC100        ASCII 74B PREFIX 
  
*         CONVERT CHARACTER IN X6 TO 8/12 BIT CHARACTER 
  
 TASC80   BSS    0
          SB4    X6 
          SA3    TVXD+B4
          BX6    X3 
          SA6    A2+B6
          JP     TASC50            NEXT CHARACTER - CHECK TRUNCATION
  
*         AN ASCII 74B OR 76B PREFIX WAS FOUND. 
*         CHECK THE NEXT 6 BITS AND DETERMINE 
*         WHETHER THIS IS A 12 BIT ASCII CHARACTER. 
  
 TASC100 BSS 0
          BX4    X1 
          LX4    6
          BX5    -X7*X4 
          ZR     X0,TASC125        ASCII 74B PREFIX 
          ZR     X5,TASC80         7600B IS TWO CHARACTERS
  
          SX0    X5-37B 
          PL     X0,TASC80         .GT. 7636B IS 2 CHARACTERS 
  
          SB4    X5 
          SA3    TVXD76+B4
          JP     TASC150           STORE CONVERTED CHARACTER
  
 TASC125  BSS    0
          SX0    X5-1B
          SA3    TVXDAT 
          ZR     X0,TASC150        7401B
  
          SX0    X5-2B
          SA3    TVXDCF 
          ZR     X0,TASC150        7402B
  
          SX0    X5-4B
          SA3    TVXDCL 
          ZR     X0,TASC150        7404B
  
          SX0    X5-7B
          SA3    TVXDGA 
          NZ     X0,TASC80         NOT GRAVE ACCENT - 2 CHARACTERS
  
 TASC150  BSS    0
          BX6    X3 
          SA6    A2+B6
          LX1    6
          SB5    B5-B1
          SB2    B2-B1
          LT     B0,B5,TASC50      NEXT CHARACTER 
  
          SA1    A1+B1             NEW WORD 
          SB5    10 
          JP     TASC50            NEXT CHARACTER 
  
*         UPDATE THE HEADER AND STORE 12 BIT CHARACTER COUNT
  
 TASC300  BSS    0
          SX7    B3 
          SA7    SDTACN 
          SB2    B6 
          SX0    B6 
          ERRNZ  S.SBCUR-N.SBCUR+1
          BX2    X0 
          OX7    X2,X0,SBTOT       UPDATE SCATTER BUFFER HEADER 
          BX2    X7 
          SA7    A2 
          JP     STRTASC           RETURN 
  
 OSSC2    ENDIF 
  
          TITLE  CSTRCCL - STRUPS - UNPACK STRING 
**        STRUPS  -  UNPACK LINE INTO SCATTER BUFFER                    006110
*                                                                       006120
*         UNPACKS CHARACTERS INTO A SCATTER BUFFER, ONE CHARACTER       006130
*         PER WORD.  IF THE INPUT IS LONGER THAN THE SPACE              006140
*         IN THE SCATTER BUFFER THE EXCESS CHARACTERS ARE IGNORED.      006150
*         UNPACKING TERMINATES BY THE CHARACTER COUNT OR THE SIZE       006160
*         OF THE SCATTER BUFFER.                                        006170
*                                                                       006180
*         ENTRY  A1  = ADDRESS OF STATEMENT.                            006190
*                X1  = FIRST 10 CHARACTERS TO UNPACK                    006200
*                A2  = SCATTER BUFFER HEADER ADDRESS                    006210
*                X2  = SCATTER BUFFER HEADER                            006220
*                B1  = 1                                                006230
*                B2  = NUMBER OF CHARACTERS TO UNPACK                   006240
*                                                                       006250
*         EXIT-  A2  = SCATTER BUFFER HEADER ADDRESS                    006260
*                X2  = UPDATED SCATTER BUFFER HEADER                    006270
*                B1  = 1                                                006280
*                B3  = TOTAL CHARACTERS IN BUFFER                       006290
                                                                        006300
                                                                        006310
 STRUPS   SUBR   =                                                      006320
          MX0    59-S.SBTOT                                             006330
          BX3    -X0*X2                                                 006340
          SB4    V.SBSIZ                                                006350
          AX3    S.SBTOT-N.SBTOT+1                                      006360
          SB3    X3                                                     006370
          SB5    A2+B1       START OF SCATTER BUFFER                    006380
          SB7    B4-B3       SPACE REMAINING IN SCATTER BUFFER          006390
          MX7    -6                                                     006400
          LT     B2,B7,UPS1  IF SPACE EXISTS FOR MAXIMUM                006420
          SB2    B7          LIMITED BY SPACE                           006430
 UPS1     BSS                                                           006440
          GE     B0,B2,UPS3  IF NO CHARACTERS TO UNPACK 
          SB6    10                                                     006460
 UPS2     LX1    6           ADVANCE DISASSEMBLY                        006470
          BX6    -X7*X1      EXTRACT CHARACTER                          006480
          SA6    B3+B5       STORE CHARACTER                            006490
          SB3    B1+B3                                                  006500
          SB2    B2-B1                                                  006510
          SB6    B6-B1                                                  006520
          GE     B0,B2,UPS3  IF ALL CHARACTERS UNPACKED                 006530
          LT     B0,B6,UPS2  IF WORD NOT COMPLETE                       006540
          SA1    A1+1        GET NEXT WORD                              006550
          SB6    10                                                     006560
          LT     B0,B2,UPS2  IF MORE CHARACTERS TO UNPACK               006570
                                                                        006580
 UPS3     BSS                                                           006590
                                                                        006600
          MX6    -N.SBCUR                                               006610
          SX0    B3          NEW TOTAL OF CHARACTERS IN BUFFER          006620
          BX2    -X6*X2                                                 006630
          LX0    S.SBTOT-N.SBTOT+1                                      006640
          BX7    X0+X2                                                  006650
          BX2    X0+X2                                                  006660
          SA7    A2          STORE UPDATED BUFFER HEADER                006670
          BX6    X6-X6       CLEAR NEXT WORD IN BUFFER
          SA6    B3+B5
          JP     STRUPS      EXIT                                       006680
