COMCJCR 
COMMON
          CTEXT  COMCJCR - JOB CONTROL REGISTER MANAGEMENT ROUTINES.
          SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCJCR
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC.  1996.
          SPACE  4
***       JCR - JOB CONTROL REGISTER MANAGEMENT ROUTINES. 
*         G. S. YODER.    96/04/24. 
          SPACE  4
***       JCR CONTAINS ROUTINES TO ACCESS AND MODIFY THE JOB CONTROL
*         REGISTERS USING SYMBOLIC REGISTER NAMES.
* 
*         *GJR* SETS THE CURRENT JOB CONTROL REGISTERS INTO A WORKING 
*         BUFFER FOR ACCESS BY *GWR* AND *SWR*. 
* 
*         *SJR* SETS THE VALUES OF THE JOB CONTROL REGISTERS FROM THE 
*         WORKING BUFFER AFTER A CALL TO *SWR*. 
* 
*         *GWR* VALIDATES THE NAME AND RETURNS THE VALUE OF THE 
*         SPECIFIED REGISTER FROM THE WORKING BUFFER. 
* 
*         *SWR* VALIDATES THE NAME AND SETS THE VALUE OF THE SPECIFIED
*         REGISTER IN THE WORKING BUFFER.  A CALL TO *SJR* MUST BE MADE 
*         TO MODIFY THE ACTUAL REGISTER.
* 
*         THE FOLLOWING REGISTER NAMES ARE PROCESSED. 
* 
*         NAME   REGISTER 
* 
*         EF     ERROR FLAG 
*         EFG    GLOBAL ERROR FLAG
*         EM     EXIT MODE
*         PNL    PROCEDURE NESTING LEVEL
*         R1     R1 REGISTER
*         R1G    R1G REGISTER 
*         R2     R2 REGISTER
*         R3     R3 REGISTER
*         SW1    SENSE SWITCH 1 
*         SW2    SENSE SWITCH 2 
*         SW3    SENSE SWITCH 3 
*         SW4    SENSE SWITCH 4 
*         SW5    SENSE SWITCH 5 
*         SW6    SENSE SWITCH 6 
 GJR      SPACE  4,10 
***       GJR - GET JOB CONTROL REGISTERS.
* 
*         EXIT   JOB CONTROL REGISTERS READ TO *JCRB*.
* 
*         MACROS GETJCI.
  
  
 GJR      SUBR               ENTRY/EXIT 
          GETJCI JCRB        GET JOB CONTROL REGISTERS
          EQ     GJRX        RETURN 
 SJR      SPACE  4,10 
***       SJR - SET JOB CONTROL REGISTERS.
* 
*         EXIT   JOB CONTROL REGISTERS SET FROM *JCRB*. 
* 
*         MACROS SETJCI.
  
  
 SJR      SUBR               ENTRY/EXIT 
          SETJCI JCRB        GET JOB CONTROL REGISTERS
          EQ     SJRX        RETURN 
 GWR      SPACE  4,20 
***       GWR - GET WORKING REGISTER VALUE FROM BUFFER. 
* 
*         ENTRY  (X1) = REGISTER NAME LEFT JUSTIFIED. 
*                PACKED JOB CONTROL REGISTERS IN *JCRB*.
* 
*         EXIT   (X7) = 0 IF NOT VALID REGISTER NAME. 
*                (X7) = 1 IF *R1*, *R2*, *R3*, OR *R1G* REGISTER. 
*                (X7) .GT. 1 IF NOT *R* REGITER.
*                (X6) = REGISTER RIGHT JUSTIFIED IF NO ERROR. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1. 
*                B - 2. 
* 
*         CALLS  VRN. 
  
  
 GWR      SUBR               ENTRY/EXIT 
          RJ     VRN         VALIDATE REGISTER NAME 
          ZR     X7,GWRX     IF NOT VALID REGISTER NAME 
          SX2    60 
          SB2    -B2
          SB2    X2+B2
          BX6    X6*X3
          LX6    B2          JUSTIFY REGISTER 
          EQ     GWRX        RETURN 
 SWR      SPACE  4,20 
***       SWR - SET WORKING REGISTER VALUE IN BUFFER. 
* 
*         ENTRY  (X1) = REGISTER NAME LEFT JUSTIFIED. 
*                (X2) = NEW REGISTER VALUE RIGHT JUSTIFIED. 
*                PACKED JOB CONTROL REGISTERS IN *JCRB*.
* 
*         EXIT   (X7) = 0 IF NOT VALID REGISTER NAME. 
*                (X7) = 1 IF *R1*, *R2*, *R3*, OR *R1G* REGISTER. 
*                (X7) .GT. 1 IF NOT *R* REGITER.
*                NEW REGISTER VALUE SET IN *JCRB*.
* 
*         USES   X - 2, 3, 6. 
*                A - 6. 
* 
*         CALLS  VRN. 
* 
*         NOTE   IF THE SPECIFIED VALUE IS GREATER THAN THE REGISTER
*                WIDTH, THE OVERFLOW (UPPER BITS) WILL BE REMOVED.
  
  
 SWR      SUBR               ENTRY/EXIT 
          RJ     VRN         VALIDATE REGISTER NAME 
          ZR     X7,SWRX     IF NOT VALID REGISTER NAME 
          LX2    B2 
          BX3    -X6*X3      CLEAR OLD VALUE
          BX2    X6*X2       REMOVE POSSIBLE OVERFLOW 
          BX6    X3+X2       MERGE NEW VALUE
          SA6    A3+         STORE REGISTER VALUE 
          EQ     SWRX        RETURN 
 VRN      SPACE  4,15 
**        VRN - VALIDATE REGISTER NAME. 
* 
*         ENTRY  (X1) = REGISTER NAME LEFT JUSTIFIED. 
* 
*         EXIT   (X7) = 0 IF NOT VALID REGISTER NAME. 
*                (X7) = 1 IF *R1*, *R2*, *R3*, OR *R1G* REGISTER. 
*                (X7) .GT. 1 IF NOT *R* REGITER.
*                (X6) = MASK TO EXTRACT REGISTER IN *JCRB* WORD.
*                (X3) = *JCRB* WORD CONTAINING REGISTER.
*                (A3) = ADDRESS OF *JCRB* WORD CONTAINING REGISTER. 
*                (B2) = FIRST BIT OF REGISTER IN *JCRB* WORD. 
* 
*         USES   X - 1, 3, 7. 
*                A - 3. 
  
  
 VRN      SUBR               ENTRY/EXIT 
          SA3    TJRP-1 
          MX6    42 
 VRN1     SA3    A3+B1       READ NEXT ENTRY
          BX7    X6*X3
          ZR     X7,VRNX     IF END OF TABLE
          BX7    X7-X1
          NZ     X7,VRN1     IF NO MATCH
          MX6    -6 
          BX7    -X6*X3      EXTRACT REGISTER SIZE
          LX3    -6 
          SB2    X7 
          BX1    -X6*X3      EXTRACT STARTING BIT IN WORD 
          LX3    -6 
          SX7    A3-ENDR
          BX3    -X6*X3      EXTRACT WORD ADDRESS 
          PL     X7,VRN2     IF NOT *R* REGISTER
          SX7    B1+         SET *R* REGISTER 
 VRN2     SA3    JCRB+X3     READ REGISTER WORD 
          MX6    1
          AX6    B2          SET FIELD MASK 
          LX6    B2 
          SB2    X1 
          LX6    B2          POSITION FIELD MASK
          EQ     VRNX        RETURN 
          SPACE  4
**        DATA AREA.
  
  
 JCRB     BSSZ   2           JOB CONTROL REGISTERS BLOCK
 TJRP     SPACE  4,15 
**        TJRP - TABLE OF JOB REGISTER PARAMETERS.
* 
*T        42/ NAME,6/ WO,6/ SB,6/ SZ
* 
*         NAME = REGISTER NAME LEFT JUSTIFIED.
* 
*         WO = WORD OFFSET IN *JCRB*. 
* 
*         SB = STARTING BIT POSITION IN WORD. 
* 
*         SZ = SIZE IN BITS.
  
  
 TJRP     BSS    0           START OF TABLE 
          VFD    42/0LR1,6/1,6/0,6/18    R1 REGISTER
          VFD    42/0LR2,6/1,6/18,6/18   R2 REGISTER
          VFD    42/0LR3,6/1,6/36,6/18   R3 REGISTER
          VFD    42/0LR1G,6/0,6/36,6/18  R1G REGISTER 
 ENDR     EQU    *           END OF *R* REGISTERS 
          VFD    42/0LEFG,6/0,6/54,6/6   GLOBAL ERROR FLAG
          VFD    42/0LPNL,6/0,6/24,6/12  PROCEDURE NESTING LEVEL
          VFD    42/0LEM,6/0,6/12,6/12   EXIT MODE
          VFD    42/0LSW1,6/0,6/6,6/1    SENSE SWITCH 1 
          VFD    42/0LSW2,6/0,6/7,6/1    SENSE SWITCH 2 
          VFD    42/0LSW3,6/0,6/8,6/1    SENSE SWITCH 3 
          VFD    42/0LSW4,6/0,6/8,6/1    SENSE SWITCH 4 
          VFD    42/0LSW5,6/0,6/10,6/1   SENSE SWITCH 5 
          VFD    42/0LSW6,6/0,6/11,6/1   SENSE SWITCH 6 
          VFD    42/0LEF,6/1,6/54,6/6    ERROR FLAG 
          CON    0           END OF TABLE 
  
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 GJR      EQU    /COMCJCR/GJR 
 SJR      EQU    /COMCJCR/SJR 
 GWR      EQU    /COMCJCR/GWR 
 SWR      EQU    /COMCJCR/SWR 
 QUAL$    ENDIF 
          ENDX
