COMPIMB 
COMMON
          CTEXT  COMPIMB - ISSUE MESSAGE TO BUFFER. 
 IMB      SPACE  4
          BASE   M
          IF     -DEF,QUAL$,1 
          QUAL   COMPIMB
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1994. 
 IMB      SPACE  4
***       COMPIMB - ISSUE MESSAGE TO BUFFER.
*         R.E. DUNBAR.       94/01/21.
 IMB      SPACE  4,20 
***       COMPIMB - ISSUE MESSAGE TO BUFFER.
* 
*         COMPIMB CONTAINS THE SUBROUTINES NEEDED TO ALLOW
*         BUFFERED I/O DRIVERS TO PLACE MESSAGES IN THE CENTRAL 
*         MEMORY ERROR MESSAGE BUFFER (*EMB*) FOR ISSUANCE BY 
*         *1MD* TO THE APPROPRIATE SYSTEM DAYFILE.  EACH MESSAGE
*         TO BE ISSUED BEGINS WITH A HEADER WORD AS FOLLOWS-
* 
*         VFD    24/ , 12/ INFO, 12/ MSGL, 1/ D819, 11/ DFTY
* 
*         INFO   DATA UNIQUE TO THE PARTICULAR TYPE OF MESSAGE. 
*                MAINTENANCE LOG MESSAGE - RESIDUAL BYTE COUNT. 
*                ERROR LOG MESSAGE - ERROR LOG ALERT FLAG.
*         MSGL   LENGTH OF MESSAGE IN *CM* WORDS INCLUDING HEADER.
*                IF THIS BYTE IS ZERO, THIS HEADER WORD IS A BUFFER 
*                TERMINATOR.  THE NEXT MESSAGE IS AT THE BEGINNING
*                OF THE BUFFER. 
*         D819   819 DRIVER FLAG - SET FOR 819 DRIVER MESSAGES ONLY.
*         DFTY   CODE IDENTIFYING THE DAYFILE TO RECEIVE THE MESSAGE. 
* 
*         THE *EMB* IS MANAGED AS A CIRCULAR BUFFER, WITH A TWO-WORD
*         HEADER CONTAINING FLAGS AND THE OFFSETS FOR *IN*, *OUT* AND 
*         *LIMIT*.  *FIRST* IS ALWAYS ZERO, WITH ALL OFFSETS RELATIVE 
*         TO *EMB* FWA+2.  SEE *NOSTEXT* FOR THE *EMB* HEADER FORMAT. 
*         ALTHOUGH THE *EMB* IS A CIRCULAR BUFFER, INDIVIDUAL MESSAGES
*         DO NOT WRAP AROUND.  IF A MESSAGE WOULD OTHERWISE WRAP THE
*         BUFFER, AN *END OF BUFFER* MARKER WITH A ZERO MESSAGE LENGTH
*         IS PLACED IN THE BUFFER, THE *IN* POINTER IS RESET, AND THE 
*         MESSAGE IS PLACED AT THE HEAD OF THE BUFFER.
* 
*         DRIVERS (AND *1MB*) PUT MESSAGES INTO THE *EMB* AND *1MD* 
*         REMOVES THEM.  MESSAGES ARE PLACED INTO THE *EMB* BY CALLING
*         SUBROUTINE *IMB* WITH THE MESSAGE ADDRESS IN THE A REGISTER.
*         *IMB* INTERLOCKS THE *EMB*, TRANSFERS THE MESSAGE TO THE
*         BUFFER AND CALLS *1MD* VIA SUBROUTINE *IMD*, IF IT IS NOT 
*         ALREADY ACTIVE. *1MD* WRITES THE MESSAGE TO THE DESIGNATED
*         DAYFILE, REMOVING IT FROM THE *EMB*.
* 
*         IF *COMPIMB* CANNOT IMMEDIATELY PLACE ITS MESSAGE IN THE
*         *EMB* BUFFER, IT CALLS *1MD* TO EMPTY THE BUFFER.  IF THE 
*         *MESSAGES LOST* FLAG IS ALREADY SET, IT THEN ABANDONS THE 
*         MESSAGE AND RETURNS.  OTHERWISE, IT RECHECKS THE BUFFER AT
*         ONE MILLISECOND INTERVALS TO SEE IF THERE IS NOW ENOUGH 
*         SPACE FOR THE MESSAGE.  IF, AFTER 512 MILLISECONDS, THERE 
*         IS STILL NO SPACE IN THE BUFFER, *COMPIMB* THEN SETS THE
*         *MESSAGES LOST* FLAG AND RETURNS.  IF *1MD* CANNOT BE 
*         CALLED DUE TO PP SATURATION, *COMPIMB* IMMEDIATELY SETS THE 
*         *MESSAGES LOST* FLAG AND RETURNS. 
* 
*         *IMB* CAN BE USED IN BOTH 4K AND 8K PPS.  THE SYMBOL *M8K$* 
*         MUST BE DEFINED IF 16-BIT INSTRUCTIONS ARE TO BE USED FOR 
*         HANDLING MESSAGE AND OTHER ADDRESSES.  IF *M8K$* IS NOT 
*         DEFINED, 12-BIT INSTRUCTIONS WILL BE USED.
* 
*         THE *EMBE* MACRO MUST BE DEFINED IN THE CALLING PROGRAM.
*         AT PRESET TIME THE PROGRAM MUST ADD THE *EMB* *FWA* INTO
*         EACH LOCATION REFERENCED IN THE TABLE GENERATED BY *EMBE* 
*         MACRO INSTANCES CONTAINED IN THE CODE.  AN EXAMPLE OF THIS
*         CAN BE SEEN BY EXAMINING A LISTING OF PROGRAM *1MB*.
 IMB      SPACE  4,20 
**        IMB - ISSUE MESSAGE TO BUFFER.
* 
*         *IMB* PLACES A MESSAGE IN THE *EMB* FOR *1MD* TO PROCESS. 
* 
*         ENTRY  (A) = ADDRESS OF MESSAGE TO BE ISSUED TO *EMB*.
* 
*         EXIT   MESSAGE ISSUED TO BUFFER IF POSSIBLE.
*                (WB+1) INCREMENTED IF MESSAGE LOST.
* 
*         USES   T2, CM - CM+4, WB - WB+4.
* 
*         CALLS  IMD. 
* 
*         MACROS DELAY, EMBE, MONITOR.
  
  
 IMB      SUBR               ENTRY/EXIT 
 M8K      IF     -DEF,M8K$
          STM    IMBB        LOCATION OF MESSAGE HEADER 
          ADN    3
          STM    IMBA        LOCATION OF MESSAGE LENGTH 
 M8K      ELSE
          STML   IMBB        LOCATION OF MESSAGE HEADER 
          ADN    3
          STML   IMBA        LOCATION OF MESSAGE LENGTH 
 M8K      ENDIF 
          LDD    TH          SET MAXIMUM RETRY COUNTER
          STD    T2 
  
*         TRY TO OBTAIN THE *EMB* INTERLOCK.
  
 IMB1     LDN    ZERL 
          CRD    CM          PRESET *UTEM* REQUEST
          EMBE   *
          LDC    0
          STD    CM+4        SET ADDRESS OF INTERLOCK WORD
          SHN    -14
          STD    CM+3 
          MONITOR  UTEM      GET *EMB* INTERLOCK
          LDD    CM+1 
          ZJN    IMB3        IF INTERLOCK OBTAINED
 IMB2     DELAY  10          DELAY 1 MILLISECOND
          UJN    IMB1        RETRY INTERLOCK ATTEMPT
  
*         *EMB* INTERLOCKED - GET *EMB* HEADER WORDS. 
  
          EMBE   *
 IMB3     LDC    0           GET *EMB* HEADER 1 (FLAGS, *IN*) 
          CRD    WB 
          ADN    1           GET *EMB* HEADER 2 (*OUT*, *LIMIT*)
          CRD    CM 
  
*         SEE IF MESSAGE WILL FIT IN THE BUFFER.
  
          LDM    **          GET MESSAGE LENGTH 
 IMBA     EQU    *-1         (MESSAGE LENGTH ADDRESS) 
          STD    CM 
 IMB4     LDD    WB+3        *IN* 
          SBD    CM+3        *OUT*
          PJN    IMB6        IF *IN* .GE. *OUT* 
          ADD    CM          MESSAGE LENGTH 
          MJN    IMB6.1      IF MESSAGE FITS BETWEEN *IN* AND *OUT* 
 IMB4.1   RJM    IMD         CALL *1MD* 
          ZJN    IMB6.2      IF UNABLE TO CALL *1MD*
          LDD    WB+1 
          NJN    IMB6.2      IF *MESSAGES LOST* IS ALREADY SET
          SOD    T2 
          ZJN    IMB6.2      IF MAXIMUM RETRY COUNT EXCEEDED
          SOD    WB+4        CLEAR INTERLOCK
          EMBE   *
          LDC    0
          CWD    WB 
          UJN    IMB2        RETRY
  
*         SEE IF MESSAGE WILL FIT BETWEEN *IN* AND *LIMIT*. 
  
 IMB6     LDD    CM          MESSAGE LENGTH 
          ADD    WB+3        *IN* 
          SBD    CM+4        *LIMIT*
 IMB6.1   MJN    IMB7        IF MESSAGE FITS BETWEEN *IN* AND *LIMIT* 
          LDD    CM+3        *OUT*
          ZJN    IMB4.1      IF *OUT* .EQ. *FIRST* - DO NOT RESET *IN*
          EMBE   *
          LDC    2           SET TERMINATOR IN *EMB*
          ADD    WB+3 
          CWM    IMDA,ON
          LDN    0           RESET *IN* 
          STD    WB+3 
          EMBE   *
          LDC    0           UPDATE HEADER
          CWD    WB 
          UJP    IMB4        RECHECK MESSAGE FIT
  
*         MAXIMUM RETRY COUNT EXCEEDED - SET *MESSAGES LOST* AND EXIT.
  
 IMB6.2   AOD    WB+1        SET *MESSAGES LOST* FLAG 
          UJN    IMB9        CLEAR INTERLOCK AND EXIT 
  
*         MESSAGE WILL FIT - PUT IT IN THE *EMB*. 
  
          EMBE   *
 IMB7     LDC    2           WRITE MESSAGE TO *EMB* 
          ADD    WB+3        ADD *IN* 
          CWM    **,CM
 IMBB     EQU    *-1         (MESSAGE ADDRESS)
          LDD    CM          UPDATE *IN*
          RAD    WB+3 
          RJM    IMD         CALL *1MD* 
 IMB9     SOD    WB+4        CLEAR INTERLOCK AND UPDATE HEADER
          EMBE   *
          LDC    0
          CWD    WB 
          LJM    IMBX        RETURN 
 IMD      SPACE  4,20 
**        IMD - INITIATE *1MD*. 
* 
*         ENTRY  (WB - WB+4) = *EMB* HEADER 1.
* 
*         EXIT   (A) .EQ. 0 IF UNABLE TO CALL *1MD*.
*                    .NE. 0 IF *1MD* HAS BEEN CALLED. 
*                *1MD CALLED* FLAG IS SET IN *WB+4* IF *1MD* CALLED.
* 
*         USES   WB+4, CM - CM+4. 
* 
*         CALLS  *1MD*. 
* 
*         MACROS EXECUTE, MONITOR.
  
  
 IMD      SUBR               ENTRY/EXIT 
          LDD    WB+4 
          LPN    2
          NJN    IMDX        IF *1MD* ALREADY CALLED
          LDD    MA 
          CWM    IMDA,ON
          LDK    ZERL 
          CRD    CM 
          LDN    10          FORCE SYSTEM CONTROL POINT 
          STD    CM+1 
          EXECUTE  1MD,=
          MONITOR  RPPM 
          LDD    CM+1 
          ZJN    IMDX        IF *RPPM* UNSUCCESSFUL 
          LDN    2           SET *1MD CALLED* FLAG
          RAD    WB+4 
          UJN    IMDX        RETURN 
  
  
 IMDA     VFD    18/3L1MD,42/1  *1MD* CALL/BUFFER TERMINATOR
          SPACE  4
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 IMB      EQU    /COMPIMB/IMB 
 QUAL$    ENDIF 
          BASE   *
 IMB      ENDX
