*DECK C$MSG 
          IDENT  C$MSG
          TITLE  C$MSG - OUTPUT MESSAGE TO DAYFILE
  
          MACHINE  ANY,I
  
          COMMENT  OUTPUT MESSAGE TO DAYFILE
          SST 
 TAF      IFEQ   OP.TAF,OP.NO 
 CBMSG    SPACE  4
**        CBMSG - OUTPUT MESSAGE TO DAYFILE 
*         ROUTINE TO OUTPUT TO THE DAYFILE A MESSAGE VIA ROUTINE -D00-, 
*         AND POSSIBLY ABORT THE JOB.  THE MESSAGE MAY BE PRECEDED BY A 
*         -SOURCE LINE    - DAYFILE MESSAGE, AND IS SUCCEEDED BY A
*         -JOB ABORTED- DAYFILE MESSAGE, IF THAT IS THE CASE.  THE MES- 
*         SAGE EXISTS ON SYSTEM TEXT OVERLAY -CB5TEXT-.  THIS TEXT
*         MAY RESIDE ON A USER LIBRARY, THE NAME OF WHICH WILL HAVE BEEN
*         PLACED IN CELL -C.LIBNM- BY PROGRAM -C.INIT-, OR THE TEXT MAY 
*         RESIDE IN -NUCLEUS- (AS IT SHOULD ON THE RELEASED -SCOPE- 
*         SYSTEM).
*              CALLED AS FOLLOWS -
*                   ANY MESSAGE INSERTIONS IN -C.MSINS- THRU -C.MSINS+5-
*                   C.HLDMS SET NON ZERO IF A SERIES OF MESSAGES TO BE
*                     OUTPUT - CLEAR IT BEFORE LAST MESSAGE IN SERIES 
*                   X1 = MESSAGE NUMBER (AS PER MESSAGE TEXT) 
*                   X2 = 0 IF MESSAGE HAS NO INSERTIONS 
*                      " 0 IF MESSAGE HAS INSERTIONS (ALREADY IN
*                        -C.MSINS- THRU -C.MSINS+5-)
*                   X3 = 0 IF SOURCE LINE NUMBER IN LOWER HALF OF 
*                        -RJ C.MSG- INSTRUCTION WORD
*                      = LOCATION WHICH CONTAINS SOURCE LINE NUMBER IN
*                        BITS 17-0
*                      = NEGATIVE IF -SOURCE LINE    - MESSAGE TO BE
*                        SUPPRESSED 
*                   X6 = 0 IF RETURN TO CALLER FOLLOWING MESSAGE ISSUE
*                      " 0 IF JOB ABORT (WITH ABORT MESSAGE) FOLLOWING
*                        MESSAGE
*                   RJ   =XC.MSG
* 
*              RETURNS - NOTHING
* 
*              REGISTERS DESTROYED -
*                   ALL BUT A0
* 
* 
*              ENTRY POINTS - 
          ENTRY  C.MSG
          ENTRY  C.MSINS
          ENTRY  C.MSD00
          ENTRY  C.MSLNO
          ENTRY  C.MSLIN
* 
*              EXTERNAL REFERENCES
*                   C.MASK
*                   C.R1U06 
*                   C.ZEROS 
* 
*              "SYSTEM" MACROS USED - 
*                   GETSP 
*                   LOADREQ 
*                   RELSP 
*                   SYSTEM  D00 
          EJECT 
          CTEXT 
          ENDX
          B1=1
          SPACE  2
 C.ADLST  VFD    42/0,18/C.CID1    CID ADDRESS LIST FOR DBUG.LN CALLS 
          VFD    42/0,18/C.CID2 
          VFD    42/0,18/C.CID3 
 C.CID1   VFD    59/0,1/1    PARAM1 
 C.CID2   DATA   300         PARAM2  CID/COBOL RUN TIME ERROR NUMBER
  
 BLANKL   VFD    6/1R ,54/0 
          ENTRY  C.HLDMS
 C.HLDMS  DATA   0           HOLD CAPSULE...MULTIPLE MESSAGES 
*                            CLEAR THE FLAG BEFORE CALLING FOR THE LAST 
*                            TIME 
* 
 C.MSD00  BSS    1           -D00- CALL PARAMETER AREA
 C.MSD00A VFD    42/7HCB5TEXT,12/0,6/1H'
 C.MSLNO  BSSZ   2           WILL CONTAIN SOURCE LINE NO. IN INSERT FORM
 C.MSINS  BSSZ   6           CONTAINS MESSAGE INSERTION(S)
* 
* 
 C.CID3   BSSZ   10          STORAGE FOR MESSAGE TO SEND DBUG.LN
 C.CIDBS  EQU    *-C.CID3    LENGTH OF BUFFER 
*                                  -D00- PARAM WORD 1 WHEN CID ACTIVE 
*                                  SHIFTED TO PREV NON-STD RELOC
 C.CIDBF  VFD    6/0,12/1000B,12/0,12/C.CIDBS,18/C.CID3 
 C.MSABT  BSS    1           "0 WHEN JOB TO BE ABORTED
 C.MSFE   VFD    2/1,10/0,12/#CBMSG2,36/0  -D00- PARAMETER WORD 1 FOR 
*                                           -JOB ABORTED- MESSAGE 
 C.MSSV   BSS    1           -D00- PARAMETER WORD 1 
 C.MSX3   BSS    1           CONTAINS X3 INPUT PARAMETER
 C.MSLIN  BSS    1           SOURCE LINE NUMBER 
  
          USE    /STP.END/
 ABTADDR  BSS    1           ADDRESS OF ABORT ROUTINE 
          USE    *
          EJECT 
 C.MSG    BSS    1
          SA6    C.MSABT     SAVE ABORT FLAG
          ZR     X6,NOCID1   JUMP IF NO ABORT AFTER MESSAGE 
          SB2    =YDBUG.FN
          NG     B2,NOCID1   JUMP IF CID NOT ACTIVE 
          MX6    1           SUPPRESS SOURCE LINE MESSAGE 
          SA5    C.CIDBF     LOC OF BUFFER FOR MESSAGE FROM D00 
          LX5    6           REPOSITION 
          ZR     X2,C.MSG1     JUMP IFF NO MESSAGE INSERTION
          BX5    X5+X6
          EQ     C.MSG1 
 NOCID1   BSS    0
          BX6    X3          SOURCE LINE FLAG 
          MX5    2           BIT 59=1 IF INSERT, BIT 58=1/MSG TO DAYFILE
          NZ     X2,C.MSG1   JUMP IF MESSAGE INSERTION(S) 
          MX5    1
          LX5    59 
 C.MSG1   LX1    36          MESSAGE NUMBER 
          IX7    X1+X5       -D00- PARAMETER WORD 1 
          SA7    C.MSSV 
          SA6    C.MSX3      SAVE SOURCE LINE FLAG
          SA3    MSGC+"PL.ADDR"    ENTRY POINT ADDR 
          SB3    X3+0 
          ZR     B3,C.MSG2
          JP     B3          ALREADY LOADED 
 C.MSG2   SB2    PLIST
          SB3    A3 
          SX4    PLOCADD
          EQ     =XC.LDCAP   GO LOAD THE CAPSULE
 PLIST    DATA   0,0
 GRPNAM   VFD    42/0LCOBOL5,18/5  GROUP NAME 
          VFD    42/0LC$MSGC,18/0 
 PLOCADD  VFD    42/0,18/PLOC 
          DATA   0
 C.MSG8   BSS    0
          SA1    C.MSABT
          ZR     X1,C.MSG10  JUMP IF JOB NOT TO BE ABORTED
          SB2    =YDBUG.FN
          NG     B2,NOCID2   JUMP IF CID NOT ACTIVE 
          SA1    C.ADLST
          RJ     =YDBUG.FN   NO RETURN FROM CID 
 NOCID2   BSS    0
          SA1    C.MSFE 
          BX6    X1 
          SA6    C.MSD00
          SYSTEM  D00,1,C.MSD00  -JOB ABORTED- MESSAGE TO DAYFILE 
          EQ     ABTADDR     GO CLOSE FILES AND DIE 
 C.MSG10  SA1    C.HLDMS     HOLD CAPSULE FLAG
          NZ     X1,C.MSG 
          SA1    X2 
          ZR     X1,NOTEXT   JP IF TEXT NOT IN CORE 
          RJ     =XCMM.FRF   FREE TEXT SPACE
 NOTEXT   BSS    0
          SA1    GRPNAM 
          SA2    A1+B1
          SX4    A2+B1
          RJ     =XFDL.ULC   UNLOAD THE CAPSULE 
          ZR     X6,C.MSG 
          EQ     *+400000B   ERROR FORCE ABORT
  
  
 PLOC     PASSLOC 
          PL.ENTRY  CMM.ALF,EXT 
          PL.ENTRY  CMM.FRF,EXT 
          PL.ENTRY  C.DEPTH,EXT 
          PL.ENTRY  C.LIBNM,EXT 
          PL.ENTRY  C.MASK,EXT
          PL.ENTRY  C.MSD00 
          PL.ENTRY  C.MSFE
          PL.ENTRY  C.MSG 
 MSGC     PL.ENTRY  C.MSGC
          PL.ENTRY  C.MSG8
          PL.ENTRY  C.MSLIN 
          PL.ENTRY  C.MSLNO 
          PL.ENTRY  C.MSSV
          PL.ENTRY  C.MSX3
          PL.ENTRY  C.STACK,EXT 
          PL.ENTRY  C.ZEROS,EXT 
          PL.ENTRY  LOD=,EXT
          PL.ENTRY  MSG=,EXT
          PL.ENTRY  SYS=,EXT
          PL.END
 TAF      ELSE
          ENTRY  C.MSG
          ENTRY  C.MSINS
          ENTRY  C.MSD00
          ENTRY  C.MSLNO
          ENTRY  C.MSLIN
          ENTRY  C.SBOVF
          ENTRY  C.HLDMS
          ENTRY  C.RFERR
          SYSCOM B1 
*COMMENT  CBMSG - TAF/COBOL DIAGNOSTIC ROUTINE. 
          COMMENT  CONTROL DATA CORP.  1978.
          TITLE  C$MSG - TAF/COBOL DIAGNOSTIC ROUTINE.
          SPACE  4
*****     CBMSG - TAF/COBOL DIAGNOSTIC ROUTINE. 
* 
*         W. E. MARTIN.      10/30/78.
          SPACE  4
***       CBMSG - TAF/COBOL DIAGNOSTIC ROUTINE. 
* 
*         CBMSG OBTAINS THE TEXT OF A PROGRAM ENCOUNTERED ERROR 
*         AND ISSUES IT TO THE TRANSACTION TERMINAL.  *TAF* TERMINALS,
*         UNLIKE *IAF* TERMINALS, HAVE NO DAYFILES ASSOCIATED WITH
*         THEM, SO THE ERROR MESSAGES MUST BE RETURNED TO THE TASK-S
*         FIELD LENGTH, AND THEN ISSUED TO THE TERMINAL VIA A *SEND*. 
* 
*         ENTRY  (C.MSINS - C.MSINS+5) = DESIRED MESSAGE INSERTIONS.
*                (C.HLDMS) .NE. ZERO - IF MORE THAN ONE MESSAGE TO BE 
*                     OUTPUT. 
*                (X1) = MESSAGE NUMBER(AS PER MESSAGE TEXT).
*                (X2) = ZERO - IF MESSAGE HAS NO INSERTIONS.
*                (X2) .NE. ZERO - IF MESSAGE HAS INSERTIONS.
*                (X3) = ZERO - IF SOURCE LINE NUMBER IN LOWER HALF OF 
*                     *RJ* INSTRUCTION CALLING *CBMSG*(TRACEBACK).
*                     = LOCATION WHICH CONTAINS SOURCE LINE NUMBER IN 
*                     BITS 17 - 0.
*                     .EQ. NEGATIVE - IF SOURCE LINE NUMBER TO BE 
*                     SUPPRESSED. 
*                (X6) = 0 - IF RETURN TO CALLER FOLLOWING MESSAGE 
*                     ISSUANCE. 
*                     .NE. ZERO - IF TASK TO ABORTED AFTER MESSAGE. 
* 
*         EXIT   DESIRED MESSAGE ISSUED TO TERMINAL.
* 
*         USES   A - ALL. 
*                X - ALL. 
*                B - ALL. 
* 
          SPACE  4
          VFD    42/0LC.MSG,18/C.MSG
  
          SA1    CMGA        RESTORE (A0) 
          SA0    X1+
  
 C.MSG    PS                 ENTRY/EXIT 
          SA5    C.MSFE 
          MX7    6
          BX7    X7*X5
          NZ     X7,C.MSG0   JP IF D00 CALL ALREADY SHIFTED 
          LX5    6           SHIFT D00 CALL FOR NO NONSTD RELOCATION
          BX7    X5 
          SA7    A5 
 C.MSG0   BSS    0
          SX7    A0          SAVE (A0)
          SA6    C.MSABT     SAVE ABORT FLAG
          BX6    X3          (X6) = SOURCE LINE FLAG
          MX5    1
          NZ     X2,C.MSG1   IF MESSAGE INSERTIONS
          MX5    0
 C.MSG1   LX1    36          MESSAGE NUMBER 
          BX7    X1+X5       (X7) = *D00* PARAMETER WORD 1
          SA7    C.MSSV 
          SA6    C.MSX3      SAVE (X3)
          SA1    C.MSFE      SET INSERTION IN *D00* HEADER
          BX7    X5+X1
          SA7    A1 
  
*         PROCESS LINE NUMBER INFORMATION.  THE BUFFER AT *C.MSD00* 
*         WILL BE USED BY *C.PRTRC* TO PRINT THE TRACE-BACK 
*         INFORMATION.
  
          SA2    C.MSX3      READ LINE NUMBER 
          NG     X2,C.MSG3   IF LINE NUMBER TO BE SUPPRESSED
          SA5    C.MSG       READ ENTRY POINT FOR CALLING ADDRESS 
          LX5    30 
          SA1    X2 
          NZ     X2,C.MSG2   IF LINE NUMBER IN (X6) 
          SA1    X5-1        READ LINE NUMBER FROM CALLING MODULE 
 C.MSG2   MX0    -15
          BX1    -X0*X1 
          RJ     =XC.MSCV    LEFT JUSTIFY, ZERO FILL LINE NUMBER
          MX0    48 
          SA5    C.MSFE      SET NEXT *D00* PARAMETER HEADER
          SA7    C.MSLIN     SAVE CONVERT LINE NUMBER 
          LX0    47-11
          SX1    #CBMSG1     LINE NUMBER MESSAGE CODE 
          LX1    36 
          BX5    X0*X5       CLEAR ERROR FIELD
          IX7    X5+X1
          MX5    1           SET INSERTION FLAG 
          BX7    X5+X7
          SA7    C.MSD00
 C.MSG3   MX0    48          SETUP *D00* PARAMETER FOR *C.PRTRC*
          SA1    C.MSSV      READ REQUESTED ERROR MESSAGE NUMBER
          SA5    C.MSFE      READ *D00* SKELETON
          LX0    47-11
          BX5    X0*X5       CLEAR ERROR NUMBER FIELD 
          SA2    C.MSD00A 
          BX6    X1+X5
          SA6    C.MSLNO
          BX7    X2 
          SA7    A6+B1
  
*         GET PROGRAM REQUESTED ERROR MESSAGE AND ISSUE TO TERMINAL.
  
          SYSTEM D00,R,C.MSLNO
          SA1    C.MSLNO
          RJ     SET         SEND ERROR TO TERMINAL 
  
*         ISSUE TRACE-BACK INFORMATION, IF REQUESTED. 
  
          SA1    C.MSX3 
          NG     X1,C.MSG4   IF NO LINE MESSAGE WANTED
          RJ     =XC.PRTRC   PRINT TRACE-BACK INFORMATION 
          SA1    C.MSD00     SET FWA OF PARAMETER BLOCK 
          RJ     SET         SEND ERROR TEXT
  
*         GET *PROGRAM ABORTED* ERROR MESSAGE FROM *SYSTEM* TEXT, 
*         AND ABORT PROGRAM.
  
 C.MSG4   SA1    C.MSABT     READ ABORT FLAG
          ZR     X1,C.MSG    IF NO TERMINATION REQUESTED
          SA1    C.MSFE      SET *D00* PARAMETER FOR THIS MESSAGE 
          BX6    X1 
          SA6    C.MSD00
          SYSTEM D00,R,C.MSD00
          SA1    C.MSD00     SET FWA OF *D00* PARAMETER BLOCK 
          RJ     SET         SEND ERROR TEXT
          SYSTEM  CTI,R,CMGC,20  DETERMINE ACTIVE TELE-PROCESSOR
          SA1    CMGC 
          SX1    X1-0        ( 0 = TLXTP )
          ZR     X1,C.MSG5   IF *NAM* NOT TELE-PROCESSOR
          SYSTEM  CTI,R,CMGD,0B  ISSUE BLANK LINE TO TERMINAAL
 C.MSG5   ABORT              EXIT TO EXECUTIVE
          SPACE  4
*         TEMPORARY AND PROGRAM STORAGE.
  
 CMGA     VFD    6/1R ,54/0 
 CMGB     VFD    1/0,1/0,1/0,1/0,1/0,1/1,6/0,18/C.MSBUF,12/0,18/C.MSGBL 
          CON    0           STORAGE FOR TERMINAL NAME
          VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/1,3/0,12/C.MSGBL*10
 CMGC     CON    -1          STORAGE FOR TELE-PROCESSOR FLAG
  
 CMGD     VFD    1/0,1/0,1/0,1/0,1/0,1/1,6/0,18/CMGE,12/0,18/CMGEL
          CON    0           STORAGE FOR TERMINAL NAME
          VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/1,3/0,12/CMGEL*10
 CMGE     DATA   C*  *       BLANK LINE 
 CMGEL    EQU    *-CMGE      LENGTH OF CHARACTER STRING 
 C.HLDMS  DATA   0           MULTIPLE MESSAGE FLAG
 C.MSD00  BSSZ   1           *D00* PARAMETER BLOCK
 C.MSD00A VFD    42/7HCB5TEXT,12/0,6/1H'
 C.MSLNO  BSSZ   2           STORAGE FOR SOURCE LINE NUMBER 
 C.MSINS  BSSZ   6           STORAGE FOR MESSAGE INSERTIONS 
 C.MSBUF  BSSZ   10          STORAGE FOR CHARACTER STRINGS
 C.MSGBL  EQU    *-C.MSBUF   LENGTH OF BUFFER 
 C.MSABT  BSS    1           STORAGE FOR ABORT TASK FLAG
  
*         *D00* HEADER FOR *ABORT* MESSAGE. 
  
*                NOTE THAT IT IS SHIFTED TO PREVENT NON-STD RELOCATION
 C.MSFE   VFD    6/0,12/1000B,12/#CBMSG2,12/C.MSGBL,18/C.MSBUF
 C.MSSV   BSS    1           STORAGE FOR *D00* PARAMETER
 C.MSX3   BSS    1           STORAGE FOR (X3) 
 C.MSLIN  BSS    1           STORAGE FOR SOURCE LINE NUMBER 
 SET      SPACE  4,25 
**        SET - SEND ERROR TEXT.
* 
*         SEND ERROR TEXT TO TERMINAL VIA *SEND* REQUEST. 
* 
*         ENTRY  (A1) = FWA OF *D00* PARAMETER BLOCK. 
*                (X1) = FIRST WORD OF *D00* PARAMETER BLOCK.
* 
*         EXIT   ERROR TEXT ISSUED TO TERMINAL. 
* 
*         USES   A - 2, 4, 6. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
* 
* 
*         MACROS SYSTEM.
  
  
 SET      PS                 ENTRY/EXIT 
          LX1    11-23
          MX0    -12
          BX1    -X0*X1 
          LX2    X1          *8 
          LX3    X1          *2 
          LX2    3
          LX3    1
          IX6    X2+X3       *10
          SA4    CMGB+2      READ ABH 
          BX7    X0*X4
          IX7    X7+X6
          SA7    A4 
          SA2    CMGB        SET WORD COUNT IN *SEND* HEADER
          BX6    X0*X2
          IX6    X6+X1
          SA6    A2 
          SYSTEM  CTI,R,A2,0B  ISSUE *COBOL* ERROR MESSAGE
          EQ     SET         RETURN 
          SPACE  4
 TAF      ENDIF 
          EJECT 
*      SUBSCRIPT OVERFLOW 
          ENTRY  C.SBOVF
 C.SBOVF  DATA   0
          SA1    C.SBOVF
          AX1    30 
          SX3    X1-1        ADDRESS OF LINE
          SX1    #SUBOVF
          MX2    0
          SX6    B1 
          RJ     C.MSG
          SPACE  3
* 
*         C.RFERR  -- REFERENCE MODIFICATION ERROR
* 
          ENTRY  C.RFERR
 C.RFERR  DATA   0
          SA1    C.RFERR
          AX1    30 
          SX3    X1-1        ADDRESS OF LINE
          SX1    #RFMSG 
          MX2    0
          SX6    B1 
          RJ     C.MSG
          EQ     C.RFERR
 C.ABT    SPACE  4
* 
*         C.ABT - ABORT JOB WITH MESSAGE IN X1 - NO INSERTS 
*                LINE NBR ADDR MUST BE IN C.LINEA 
*                ENTERED VIA RJ FOR TRACEBACK 
* 
          ENTRY  C.ABT
 C.ABT    BSS    1
          MX2    0           NO INSERTS 
          SA3    =XC.LINEA   GET ADDR OF LINE NUMBER
          MX6    1           ABORT FLAG 
          RJ     C.MSG
          END 
