Retro1.org codex

          IDENT  TMSG
          ENTRY  TMSG
          SYSCOM B1
          TITLE  TMSG - TAF MESSAGE TO DAYFILE.
*COMMENT  TMSG - TAF MESSAGE TO DAYFILE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 TMSG     SPACE  4,10
****      TMSG - TAF MESSAGE TO DAYFILE
*
*         A. E. SCHIPPERS.   80/06/27.
*
*         TMSG IS AN INTERFACE ROUTINE WHICH WILL ISSUE A
*         MESSAGE TO THE *TAF* DAYFILE FROM A SYSTEM TASK.
 
*IF DEF,TRANC5
*         NOTE   THIS IS THE COBOL5 VERSION OF TMSG.
*ENDIF
*IF DEF,TRANF4
*         NOTE   THIS IS THE FORTRAN4 VERSION OF TMSG.
*ENDIF
*IF DEF,TRANF5
*         NOTE   THIS IS THE FORTRAN5 VERSION OF TMSG.
*ENDIF
 TMSG     SPACE  4,20
***       TMSG - TAF MESSAGE TO DAYFILE.
*
*         ENTRY  COMPASS - SCALL TMSG,(MESSAGE,LENGTH)
*                COBOL - ENTER TMSG USING MESSAGE[, LENGTH].
*                FORTRAN - CALL TMSG(MESSAGE,LENGTH)
*
*         WHERE - MESSAGE    DATA ITEM CONTAINING THE DAYFILE MESSAGE.
*                            COBOL - 01 LEVEL ITEM.
*                            FORTRAN - HOLLERITH.
*
*                 LENGTH     LENGTH OF MESSAGE IN CHARACTERS.
*                            COBOL - 01 LEVEL COMPUTATIONAL-1 DATA
*                            NAME.
*                            FORTRAN - INTEGER.
*
*         EXIT   MESSAGE ISSUED TO DAYFILE.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 3, 4, 6.
*                B - 1, 2, 3.
*
*         MACROS SYSTEM.
*
*         NOTE   SYSTEM TASKS ARE THE ONLY TASKS ALLOWED TO ISSUE
*                MESSAGES TO THE *TAF* DAYFILE.
 TMSG     SPACE  4,10
*         COMMON DECKS.
 
*CALL     COMKMAC
 TMSG     SPACE  4,10
*         THE FOLOWING CODE IS CONDITIONALLY PUT ON THE
*         COMPILE FILE AT MODIFICATION TIME.  THIS CODE
*         ALSO SETS VALUES FOR CONDITIONAL ASSEMBLY OF SOME
*         CODE LATER IN THIS DECK.
 
 .1       SET    0
*IF DEF,TRANC5
 .1       SET    .1+1
 .2       SET    0           COBOL5 VERSION
*ENDIF
*IF DEF,TRANF4
 .1       SET    .1+1
 .2       SET    1           FORTRAN4 VERSION
*ENDIF
*IF DEF,TRANF5
 .1       SET    .1+1
 .2       SET    2           FORTRAN5 VERSION
*ENDIF
 .A       IFNE   .1,1
 
*         ONE AND ONLY ONE OF THE TLIBXX LIBRARIES MUST BE
*         DEFINED AT MODIFICATION TIME.
 
          ERR                MODIFICATION ERRORS
 
 .A       ENDIF
 TMSG     SPACE  4,10
          VFD    42/0LTMSG,18/TMSG
 TMSG     SUBR               ENTRY/EXIT
          SB1    1
          SA1    A1
          BX3    X3-X3
 .B       IFEQ   .2,0        IF COBOL5 VERSION
 
*         PROCESS PARAMETER LIST FOR COBOL5.
 
          MX3    -18         GET LENGTH OF MESSAGE
          BX4    X1
          LX4    17-53
          BX3    -X3*X4
 .B       ENDIF
 .C       IFEQ   .2,1        IF FORTRAN4 VERSION
 
*         PROCESS PARAMETER LIST FOR FORTRAN4.
 
 
*         NO SPECIAL PROCESSING NEEDED.
 
 .C       ENDIF
 .D       IFEQ   .2,2        IF FORTRAN5 VERSION
 
*         PROCESS PARAMETER LIST FOR FORTRAN5.
 
 
*         NO SPECIAL PROCESSING NEEDED.
 
 .D       ENDIF
          SA2    A1+1        GET NEXT PARAMETER
          ZR     X2,TMS1     IF LENGTH PARAMETER NOT SPECIFIED
          SA2    X2+         FWA OF LENGTH
          SX3    X2+         LENGTH
 TMS1     SX2    10          CHARACTERS PER WORD
          IX6    X3/X2       GET NUMBER OF FULL WORDS.
          SB2    X6+
          SX4    B0+
          SX2    10          CHARACTERS PER WORD
          UX3    X3,B7
          IX2    X6*X2       CHARACTERS IN FULL WORDS
          LX3    X3,B7
          IX2    X3-X2       NUMBER OF CHARACTERS IN LAST WORD
          SX3    6           BITS PER CHARACTER
          IX3    X2*X3       MASK FOR CHARACTERS IN LAST WORD
          ZR     X2,TMS2     IF LAST WORD FULL
          MX4    1
          SB3    -1
          SB3    X3+B3       SHIFT COUNT
          AX4    B3
 TMS2     SA2    X1+B2       GET LAST WORD OF MESSAGE
          SX6    A2          SAVE ADDRESS OF LAST WORD
          SA6    TMSA
          BX6    X2          SAVE LAST WORD OF MESSAGE
          SA3    A2+B1       GET WORD FOLLOWING MESSAGE
          SA6    A6+B1
          BX6    X3          SAVE WORD FOLLOING MESSAGE
          SA6    A6+B1
          BX6    X4*X2       ZERO OUT TRAILING BITS
          SA6    A2
          BX6    X6-X6       ZERO OUT WORD FOLLOWING MESSAGE
          SX3    X1
          SA6    A6+1
          SYSTEM TMS,R,X3,B0 ISSUE *TMS* REQUEST
          SA2    TMSA        ADDRESS OF LAST WORD OF MESSAGE
          SA3    A2+B1       RESTORE LAST WORD OF MESSAGE
          BX6    X3
          SA6    X2+
          SA3    A3+B1       RESTORE WORD FOLLOWING MESSAGE
          BX6    X3
          SA6    X2+1
          EQ     TMSGX       EXIT.
 
 
 
*         STORAGE FOR WORDS DESTROYED BY TMSG REQUEST.
 
 TMSA     BSS    3
          END