COMCECS 
COMMON
          CTEXT  COMCECS - ECS INTERPRETIVE MODE MACRO PROCESSORS.
          SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCECS
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 ECS      SPACE  4,10 
***       COMCECS - ECS INTERPRETIVE MODE MACRO PROCESSORS. 
*         A. J. BEEKMAN.     77/04/11.
 ECS      SPACE  4,10 
***       *COMCECS* CONTAINS PROCESSORS *REC=* AND *WEC=* WHICH 
*         PROCESS THE INTERPRETIVE MODE ECS READ AND WRITE
*         INSTRUCTIONS.  THE PROCESSORS BREAK LARGE TRANSFERS INTO
*         SMALLER BLOCKS AND ALSO ATTEMPT TO RECOVER ECS ERRORS IN A
*         MANNER TRANSPARENT TO THE USER. 
* 
*         THIS COMMON DECK REQUIRES ONE OF THE FOLLOWING -
*                1) COMMON DECK *COMCECM*.
*                2) ASSEMBLY USING *ECSTEXT*. 
 ECS      SPACE  4,10 
**        ROUTINES CALLED.
* 
*         ELM.
 REC=     SPACE  4,20 
***       REC= - READ ECS INTERPRETIVE MODE PROCESSOR.
* 
*         ENTRY  (A0) = CM ADDRESS TO READ TO.
*                (X0) = ECS ADDRESS TO READ FROM. 
*                (REC=)-1 = 30/,9/,3/B REGISTER,18/WORD COUNT.
* 
*         EXIT   ALL REGISTERS RESTORED.
* 
*         USES   A - 1, 7.
*                X - 1, 4, 6, 7.
* 
*         CALLS  RSR, RWE, SVR. 
  
  
 REC1     RJ     RSR         RESTORE REGISTERS
  
 REC=     PS                 ENTRY/EXIT 
          RJ     SVR         SAVE ALL REGISTERS 
          SA1    REC=        SET WORD COUNT 
          SX4    B0+         SET READ ECS INSTRUCTION 
          RJ     RWE         READ/WRITE ECS 
          NG     X1,REC1     IF UNRECOVERED ECS ERROR 
          SA1    REC=        SET RETURN JUMP FOR NO ERROR 
          SX6    B1 
          LX6    30 
          IX7    X1+X6
          SA7    A1 
          EQ     REC1        RESTORE REGISTERS
 WEC=     SPACE  4,20 
***       WEC= - WRITE ECS INTERPRETIVE MODE PROCESSOR. 
* 
*         ENTRY  (A0) = CM ADDRESS TO WRITE FROM. 
*                (X0) = ECS ADDRESS TO WRITE TO.
*                (WEC=)-1 = 30/,9/,3/B REGISTER,18/WORD COUNT.
* 
*         EXIT   ALL REGISTERS RESTORED.
* 
*         USES   A - 1, 7.
*                X - 1, 4, 6, 7.
* 
*         CALLS  RSR, RWE, SVR. 
  
  
 WEC1     RJ     RSR         RESTORE REGISTERS
  
 WEC=     PS                 ENTRY/EXIT 
          RJ     SVR         SAVE ALL REGISTERS 
          SA1    WEC=        SET WORD COUNT 
          SX4    B1+         SET WRITE ECS INSTRUCTION
          RJ     RWE         READ/WRITE ECS 
          NG     X1,WEC1     IF UNRECOVERED ECS ERROR 
          SA1    WEC=        SET RETURN JUMP FOR NO ERROR 
          SX6    B1 
          LX6    30 
          IX7    X1+X6
          SA7    A1 
          EQ     WEC1        RESTORE REGISTERS
 RSR      SPACE  4,10 
**        RSR - RESTORE ALL REGISTERS.
* 
*         ENTRY  (REGA - REGA+7) = PREVIOUS *A* REGISTER CONTENTS.
*                (REGB - REGB+7) = PREVIOUS *B* REGISTER CONTENTS.
*                (REGX - REGX+7) = PREVIOUS *X* REGISTER CONTENTS.
* 
*         EXIT   PREVIOUS REGISTER CONTENTS RESTORED. 
* 
*         USES   ALL REGISTERS. 
  
  
 RSR      PS                 ENTRY/EXIT 
          MX0    18 
          SA5    REGX+5      *X5* VALUE 
          SB2    B0 
          SA2    RSRA        PRESET TO RESTORE X5 
          SX1    74B
          BX7    -X1*X2 
          PL     X5,RSR1     IF VALUE IS .GE. ZERO
          BX7    X7+X1
  
*         MODIFY INSTRUCTIONS TO SAVE *B* REGISTERS.
  
 RSR1     SB1    1
          LX0    33          SET MASK FOR INSTRUCTION MODIFICATION
          MX4    0
          SB3    7           SET HIGHEST REGISTER NUMBER
          SB4    15          SET SHIFT COUNT
 RSR2     SA2    A2+B1       GET NEXT WORD OF INSTRUCTIONS
          SA1    REGB+1+B2   GET *B* REGISTER VALUE 
          IX6    X7+X4       SAVE PREVIOUS WORD OF INSTRUCTIONS 
          BX4    -X0*X2 
          LX3    X1,B4
          SB2    B2+B1       INCREMENT *B* REGISTER NUMBER
          SA6    A2-B1
          BX7    X0*X3
          NE     B2,B3,RSR2  IF NOT END OF *B* REGISTERS
          LX0    15          SAVE LAST INSTRUCTION WORD 
          BX4    -X0*X2 
          LX7    15 
          IX6    X7+X4
          SA6    A2 
  
*         RESTORE *A0*, *A1*, *A6*, *A7*, *X0*, *X1*, *X6* AND *X7*.
  
          SA3    REGX        *X0* VALUE 
          SA1    REGA        *A0* VALUE 
          UX5    X5,B6
          BX0    X3 
          MX4    60 
          LX5    11 
          SB7    X4+777777B  *B7* = -0
          SA0    X1+B7
          UX5    X5,B5
          SA1    REGA+6      *A6* VALUE 
          SA2    A1+B1       *A7* VALUE 
          LX5    11 
          SA3    X1+B7       GET CONTENTS OF *A6* AND *A7* VALUES 
          SA4    X2+B7
          BX6    X3 
          BX7    X4 
          SA3    REGA+1      *A1* VALUE 
          SA6    X1+B7
          UX5    X5,B4
          SA7    X2+B7
          LX5    11 
          SA2    REGX+6      *X6* VALUE 
          SA1    X3+B7
          BX6    X2 
          UX5    X5,B3
          SA3    A2+B1       *X7* VALUE 
          SA4    REGX+1      *X1* VALUE 
          LX5    11 
          BX7    X3 
          BX1    X4 
  
*         RESTORE *A2* - *A4* AND *X2* - *X4*.
  
          SA2    REGA+2      *A2* VALUE 
          UX5    X5,B2
          SA3    REGX+2      *X2* VALUE 
          LX5    11 
          SA2    X2+B7
          SA4    REGA+3      *A3* VALUE 
          UX5    X5,B1
          BX2    X3 
          SA3    X4+B7
          SA5    REGX+3      *X3* VALUE 
          BX3    X5 
          SA4    REGA+4      *A4* VALUE 
          SA5    REGX+4      *X4* VALUE 
          SA4    X4+B7
          BX4    X5 
  
*         RESTORE *A5*, *X5* AND *B1* - *B7*. 
  
          SA5    REGA+5      *A5* VALUE 
          JP     RSR3        PURGE STACK BEFORE CONTINUING
 RSR3     SA5    X5+B7
 RSRA     EQU    *           CODE MODIFIED FROM HERE TO EXIT
          NO
          NO
          ERRNZ  $-14        ASSUMES MASK IN LOWER 15 BITS
          MX5    0           SET *X5* VALUE 
*         MX5    60          (IF X5 .LT. 0) 
          PX5    X5,B1
          SB1    B7+0        SET *B1* VALUE 
*         SB1    (REGB+1) 
          LX5    49 
          PX5    X5,B2
          SB2    B7+0        SET *B2* VALUE 
*         SB2    (REGB+2) 
          LX5    49 
          PX5    X5,B3
          SB3    B7+0        SET *B3* VALUE 
*         SB3    (REGB+3) 
          LX5    49 
          PX5    X5,B4
          SB4    B7+0        SET *B4* VALUE 
*         SB4    (REGB+4) 
          LX5    49 
          PX5    X5,B5
          SB5    B7+0        SET *B5* VALUE 
*         SB5    (REGB+5) 
          LX5    49 
          PX5    X5,B6
          SB6    B7+0        SET *B6* VALUE 
*         SB6    (REGB+6) 
          SB7    B7+0        SET *B7* VALUE 
*         SB7    (REGB+7) 
          EQ     RSR         RETURN 
 RWE      SPACE  4,20 
**        RWE - READ/WRITE ECS. 
* 
*         ENTRY  (X1) = 30/RETURN JUMP ADDRESS,30/
*                (X4) = 0 IF READ ECS.
*                     = 1 IF WRITE ECS. 
*                (REGA) = CM ADDRESS. 
*                (REGX) = ECS ADDRESS.
*                (REGB) = *B* REGISTER CONTENTS BLOCK.
* 
*         EXIT   (X1) .LT. 0 IF UNRECOVERED ERROR ENCOUNTERED.
* 
*         USES   A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 4. 
*                X - 0, 1, 2, 3, 5, 6, 7. 
  
  
 RWE13    SA1    RWEC        FETCH ERROR FLAG 
  
 RWE      PS                 ENTRY/EXIT 
          SX7    B0+         CLEAR ERROR FLAG 
          SA7    RWEC 
  
*         GET WORD COUNT TO TRANSFER. 
  
          AX1    30          GET ADDRESS OF WORD COUNT
          SX6    X1 
          SA3    X6-1        FORM WORD COUNT
          MX0    -18
          BX7    -X0*X3 
          SA2    REGA        RESTORE *A0* 
          SA1    REGX        RESTORE *X0* 
          SA0    X2+
          BX0    X1 
          AX3    18 
          MX1    -3 
          BX3    -X1*X3 
          ZR     X3,RWE1     IF NO *B* REGISTER SPECIFIED 
          SA1    REGB+X3     GET *B* REGISTER WORD COUNT
          IX7    X1+X7
 RWE1     SA7    RWEA 
  
*         BREAK TRANSFER INTO SMALL BLOCKS. 
  
 RWE2     SX5    400B        CHECK BLOCK SIZE 
          SA1    RWEA 
          ZR     X1,RWE13    IF ALL WORDS TRANSFERED
          IX6    X1-X5
          PL     X6,RWE3     IF FULL 400B WORD BLOCK AVAILABLE
          SX5    X1          SET WORDS REMAINING
          SX6    B0 
 RWE3     SA6    A1 
          SB4    X5          SET BLOCK WORD COUNT 
          NZ     X4,RWE5     IF WRITE 
          RD     B4          READ ECS BLOCK 
          EQ     RWE6        PROCESS ECS ERROR
  
 RWE4     SA0    A0+B4       INCREMENT ADDRESSES
          SX5    B4+
          IX0    X0+X5
          EQ     RWE2        SET SIZE OF NEXT BLOCK 
  
 RWE5     WT     B4          WRITE ECS BLOCK
          EQ     RWE6        PROCESS ECS ERROR
  
          EQ     RWE4        INCREMENT ADDRESSES
  
*         PROCESS ECS ERROR.
  
 RWE6     SX6    X4+1        SET READ/WRITE FLAG
          LX6    18 
          BX7    X6+X5       ADD WORD COUNT FOR TRANSFER
          SA7    ELMB+1 
          EQ     RWE10       TRY SINGLE WORD TRANSFERS
  
 RWE7     LX3    -18         POSITION RETRY COUNT/RECOVERY STATUS 
          SX5    A0          ADD IN CM ADDRESS
          LX5    24 
          BX6    X3+X5
          BX7    X6+X0       ADD ECS ADDRESS
          SA2    RWEB 
          MX1    48 
          SA7    ELMB+2 
          ZR     X2,RWE8     IF DAYFILE MESSAGE LIMIT REACHED 
          SA5    ELMB        CLEAR DAYFILE LIMIT AND COMPLETION BIT 
          BX6    X1*X5
          SA6    A5 
          SYSTEM ELM,R,ELMB  CALL *ELM* TO PROCESS ERROR MESSAGE
          SA2    A5          CHECK DAYFILE MESSAGE LIMIT
          MX1    -11
          AX2    1
          BX6    -X1*X2 
          SX6    X6-1 
          SA6    RWEB 
 RWE8     BX1    X3 
          LX1    59-48
          PL     X1,RWE12    IF SINGLE WORD READ RECOVERED
          MX7    1           SET UNRECOVERED ERROR FLAG 
          SA7    RWEC 
          EQ     RWE12       CONTINUE SINGLE WORD RECOVERY
  
*         RETRY WITH SINGLE WORD TRANSFERS. 
  
 RWE10    SA2    A0          READ WORD OF DATA
          SX3    101B        SET UNRECOVERED ERROR WITH RETRY 
          BX6    X2 
          SA6    ELMB+3      SET BAD DATA 
          NZ     X4,RWE11    IF WRITE 
          RD     1           READ ONE ECS WORD
          EQ     RWE7        PROCESS UNRECOVERED ERROR
  
          SA2    A0          VERIFY DATA
          SX3    1           SET RECOVERED STATUS 
          BX7    X2-X6
          ZR     X7,RWE12    IF DATA VERIFIES 
          BX7    X2          SET GOOD DATA
          SA7    A6+B1
          EQ     RWE7        ISSUE MESSAGE
  
 RWE11    WT     1           WRITE ONE ECS WORD 
          EQ     RWE7        PROCESS UNRECOVERED ERROR
  
 RWE12    SA0    A0+B1       INCREMENT ADDRESSES
          SX3    B1 
          IX0    X0+X3
          SB4    B4-B1       DECREMENT WORD COUNT 
          NZ     B4,RWE10    IF MORE WORDS TO CHECK 
          EQ     RWE2        READ/WRITE NEXT BLOCK
  
 RWEA     CON    0           WORD COUNT TO TRANSFER 
 RWEB     CON    1           DAYFILE MESSAGE LIMIT FLAG 
 RWEC     CON    0           UNRECOVERED ERROR FLAG 
 SVR      SPACE  4,10 
**        SVR - SAVE ALL REGISTERS. 
* 
*         EXIT   (B1) = 1.
*                (REGA - REGA+7) = *A* REGISTER VALUES. 
*                (REGB - REGB+7) = *B* REGISTER VALUES. 
*                (REGX - REGX+7) = *X* REGISTER VALUES. 
* 
*         USES   A - 3, 6, 7. 
*                B - 1, 2, 3, 7.
*                X - 3, 4, 6, 7.
  
  
 SVR      PS                 ENTRY/EXIT 
  
*         HOLD *B7* VALUE.
  
 .1       IF     DEF,B1=1 
          SB1    B7+777777B  SAVE *B7*
 .1       ELSE
          PL     B7,*+2      CONSTRUCT TRAIL DESCRIBING *B7*
          RJ     *+1
 SVR1     CON    0
          DUP    17 
          SB7    B7+B7
          PL     B7,*+3 
          RJ     *+1
          CON    0
          ENDD
 .1       ENDIF 
  
*         SAVE *X* REGISTERS. 
  
          SB7    A7+777777B  HOLD *A7*
          SA7    REGX+7      SAVE *X7*
          SX7    B7+777777B  SAVE *A7*
          SA7    REGA+7 
          MX7    60 
          SB7    X7+777777B  FORCE -0 IN B REGISTER 
          SX7    A6+B7       SAVE *X6* AND *A6* 
          SA6    REGX+6 
          SA7    REGA+6 
          BX6    X0          SAVE *X0* AND *X1* 
          LX7    X1 
          SA6    REGX 
          SA7    REGX+1 
          BX6    X2          SAVE *X2* AND *X3* 
          LX7    X3 
          SA6    REGX+2 
          SA7    REGX+3 
          BX6    X4          SAVE *X4* AND *X5* 
          LX7    X5 
          SA6    REGX+4 
          SA7    REGX+5 
  
*         SAVE *A* REGISTERS. 
  
          SX6    A0+B7       SAVE *A0* AND *A1* 
          SX7    A1+B7
          SA6    REGA 
          SA7    REGA+1 
          SX6    A2+B7       SAVE *A2* AND *A3* 
          SX7    A3+B7
          SA6    REGA+2 
          SA7    REGA+3 
          SX6    A4+B7       SAVE *A4* AND *A5* 
          SX7    A5+B7
          SA6    REGA+4 
          SA7    REGA+5 
  
*         SAVE *B* REGISTERS. 
  
 .2       IF     DEF,B1=1 
          SX7    1
 .2       ELSE
          SX7    B1+777777B 
 .2       ENDIF 
          SA7    REGB+1      SAVE *B1*
          SX6    B2+B7       SAVE *B2* AND *B3* 
          SX7    B3+B7
          SA6    REGB+2 
          SA7    REGB+3 
          SX6    B4+B7       SAVE *B4* AND *B5* 
          SX7    B5+B7
          SA6    REGB+4 
          SA7    REGB+5 
          SX6    B6+B7       SAVE *B6* AND *B0* 
          SX7    B0+B7
          SA6    REGB+6 
          SA7    REGB 
  
*         RESTORE *B7* VALUE. 
  
 .3       IF     DEF,B1=1 
          SX6    B1+B7       SET *B7* 
 .3       ELSE
          SA3    SVR1        RECONSTRUCT *B7* 
          SB2    17 
          SB3    3
          MX4    1
          BX6    X6-X6
 SVR2     LX3    59-56       FOLLOW *B7* TRAIL TO RECONSTRUCT 
          BX3    X3*X4
          SA7    A3          CLEAR TRAIL
          IX6    X3+X6
          SB2    B2-1 
          SA3    A3+B3
          LX6    1
          PL     B2,SVR2     IF NOT END OF TRAIL
 .3       ENDIF 
          SA6    REGB+7      SAVE *B7*
          SB1    1           SET *B1* VALUE 
          EQ     SVR         RETURN 
          SPACE  4,10 
 ELMB     VFD    24/0,12/5,12/2REC,11/0,1/0  *ELM* CALL BLOCK 
          BSSZ   4
 REGA     BSS    8           *A* REGISTERS
 REGB     BSS    8           *B* REGISTERS
 REGX     BSS    8           *X* REGISTERS
 ECS      SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 REC=     EQU    /COMCECS/REC=
 WEC=     EQU    /COMCECS/WEC=
 QUAL$    ENDIF 
          ENDX
