COMPSTI 
COMMON
          CTEXT  COMPSTI - SET TRACK INTERLOCK. 
          SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMPSTI
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       STI - SET TRACK INTERLOCK.
*         J. L. WARDELL      72/05/24.
 STI      SPACE  4,15 
***       COMPSTI SETS THE TRT INTERLOCK FOR THE TRACK SPECIFIED. 
* 
*         IF *STI$* IS DEFINED, CONTROL IS RETURNED TO THE CALLER 
*         IF THE TRACK IS ALREADY INTERLOCKED.  OTHERWISE, THE
*         THE *STBM* WILL BE RETRIED EVERY 100 MILLISECONDS UNTIL 
*         THE INTERLOCK IS ACHIEVED OR UNTIL AN OPERATOR OVERRIDE 
*         IS DETECTED.
* 
*         IF *TNR$* IS DEFINED, CONTROL IS RETURNED TO THE CALLER 
*         IF THE TRACK IS NOT RESERVED.  OTHERWISE, *CPUMTR* WILL 
*         HANG THE PP IF AN UNRESERVED TRACK IS DETECTED. 
* 
*         ENTRY  (T5) = EST ORDINAL.
*                (T6) = TRACK.
* 
*         EXIT   (A) = 0 IF TRACK INTERLOCKED.
*                    = 1 IF TRACK ALREADY INTERLOCKED (STI$ DEFINED). 
*                    = 2 IF TRACK NOT RESERVED (TNR$ DEFINED).
* 
*         USES   T0, CM - CM+4. 
* 
*         MACROS DELAY, MONITOR, PAUSE. 
* 
*         XREF   COMSCPS. 
  
  
 STI$     IF     -DEF,STI$
 STI2     LDD    CM+1        RESTORE EXIT CONDITION 
 STI$     ENDIF 
  
 STI      SUBR               ENTRY/EXIT 
 STI1     LDD    T5          SET EST ORDINAL
 TNR$     IF     DEF,TNR$ 
          LMC    2000        SET RETURN IF TRACK NOT RESERVED 
 TNR$     ENDIF 
          STD    CM+1 
          LDD    T6          SET TRACK
          STD    CM+2 
          LDN    STIS        SET TRACK INTERLOCK
          STD    CM+3 
          MONITOR STBM
          LDD    CM+1 
 TNR$     IF     DEF,TNR$ 
          LMN    2
          NJN    STI1.0      IF NOT *TRACK NOT RESERVED*
          LMN    2
          UJN    STIX        RETURN 
  
 STI1.0   LMN    2
 TNR$     ENDIF 
 STI$     IF     DEF,STI$ 
          UJN    STIX        RETURN 
 STI$     ELSE
          ZJN    STIX        IF INTERLOCK SET 
  
*         DELAY 100 MILLISECONDS AND RETRY. 
  
          LDC    1400 
          STD    T0 
 STI1.1   DELAY 
          PAUSE 
          LDD    CM+1 
          LMN    ORET 
          ZJP    STI2        IF *ORET* ERROR FLAG SET 
          SOD    T0 
          PJN    STI1.1      IF MORE DELAY REQUIRED 
          LJM    STI1        LOOP TO RETRY INTERLOCK
 STI$     ENDIF 
          SPACE  4
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 STI      EQU    /COMPSTI/STI 
 QUAL$    ENDIF 
          ENDX
