*COMDECK  CCLXSS
          TITLE  CCLXSS - EXECUTE SUBSYSTEM FUNCTION
**        SS  -  SUBSYSTEM STATUS FUNCTION
* 
*         THE SUBSYSTEM FUNCTION IS USED TO DETERMINE THE SUBSYSTEM THAT
*         IS CURRENTLY ACTIVE.  IN NOS THIS CAN BE ONE OF THE FOLLOWING-
*         - NULL, BASIC, FORTRAN, FTNTS, EXECUTE, BATCH, ACCESS, TRANACT
*         ON NOSBE AND SCOPE 2 THE FUNCTION WILL RETURN *UNDEFINED* 
* 
*         THE FOLLOWING CALLS ARE ALLOWED TO THE SUBSYSTEM FUNCTION --
* 
*         CONTROL CARD        NOS              NOSBE AND SCOPE 2
*        -DISPLAY,SS.         SS DISPLAYED     *UNDEFINED* DISPLAYED
*        -SET,SS=NAME.        SS RESET         NO OPERATION 
*        -IFE,SS=NAME..       T,F RETURNED     T,F RETURNED 
*        -WHILE,SS=NAME...
*        -...FILE(LFN,SS=NAME)...CCL153- ILLEGAL FUNCTION CALL... 
* 
*         ENTRY  EXPRESSION PROCESSING ADVANCED THROUGH THE SEPARATOR 
*                FOLLOWING *SS*.  THE PROCESSOR CALLING THE FUNCTION IS 
*                IDENTIFIED BY THE CONTENTS IN *PROCESS* -- 0=DISPLAY,
*                1=IFE/WHILE, 2=SET, -1=UNDEFINED, SETSS=SET.  CONTENTS 
*                OF SUBS IS A CODE INDICATING THE SUBSYSTEM AS PRESET.
* 
*         EXIT   -DISPLAY,*SS*, SET,*SS* OR T,F EXPRESSION VALUE
* 
  
 CCLXSS   SUBR   =           ENTRY FROM SET PROCESSOR 
 SS       BSS                ENTRY - SUBSYSTEM PROCESS
          SA2    PROCESS
          SB6    X2 
          ZR     X2,SSDIS    CASE --> DISPLAY,SS. 
  
*         REQUIRE *SS=NAME* 
  
          SA1    ANSSEP 
          SX0    X1-1R= 
          SX1    MSG176      =SS
          SX3    MSG152      =FUNCTION POORLY FORMED
          LX1    18 
          BX3    X1+X3
          NZ     X0,SSERR    IF SEPARATOR NOT *=* 
  
          RJ     CCLGNP1     GET NEXT PARAMETER 
          NZ     X5,SSERR1   ERROR IN PARAMETER 
  
          SB2    B0          OFFSET 
          SA1    ANSSTR      SUBSYSTEM NAME 
 SS001    BSS 
          SA2    SSTAB+B2 
          IX4    X1-X2
          SB2    B2+B1
          SX3    MSG163      =SUBSYSTEM REFERENCE ERROR 
          ZR     X2,SSERR    SUBSYSTEM NOT IN TABLE 
          NZ     X4,SS001    CONTINUE TABLE SEARCH
  
          SB2    B2-B1       DECREMENT SS ORDINAL FOR LAST ADD
          SA1    PROCESS
          SB6    X1          ENTRY PROCESSOR
          EQ     B6,B1,SSCON CASE --> IFE, WHILE
  
*         CASE --> SET,SS=NAME.  OR  DISPLAY,SS.
  
 SSDIS    BSS 
          EQ     B6,B0,SSDIS1 CASE --> DISPLAY,SS.
  
*         CASE --> SET,SS=NAME. 
  
 OSNOS    IFEQ   HOST,NOS 
  
*         B2 HAS SUBSYSTEM ORDINAL FOR SETSS MACRO
  
*          SET SUBSYSTEM
  
          SETSS  B2 
  
 OSNOS    ENDIF 
  
          MX3    0           CLEAR - NO ERROR INDICATOR FOR SET 
          JP     CCLXSS      EXIT 
  
  
 SSDIS1   BSS                CASE --> DISPLAY,SS. 
          SA1    SUBS        SUBSYSTEM ORDINAL AT PRESET TIME 
          SB2    X1 
          SX3    SSTAB+B2 
          RJ     STRMSG      DISPLAY SUBSYSTEM NAME IN DAYFILE
  
          JP     EVXEX50     EXIT 
  
 SSCON    BSS                CASE --> IFE, WHILE *SS=NAME*, T/F 
  
*         FINISH PROCESSING EXPRESSION
*         SUBS HAS SS ORDINAL FROM GET AT PRESET TIME 
*         B2 HAS SS ORDINAL FOR THIS EXPRESSION 
  
          SA1    SUBS 
          SB7    X1          SUBSYSTEM ORDINAL AT PRESET TIME 
          SX6    B1          TRUE EXPRESSION, =1
          EQ     B2,B7,EVX20 ADD VALUE TO STACK 
  
          SX6    B0          FALSE, =0
          JP     EVX20       ADD VALUE TO STACK 
  
  
 SSERR    BSS 
          SB2    B0 
          JP     SSERR2      COMMON 
  
 SSERR1   BSS 
          SB2    B1 
          MX3    0
 SSERR2   BSS 
          SA1    PROCESS
          SX0    =5RSETSS 
          BX0    X0-X1
          ZR     X0,CCLXSS   EXIT VIA SET ENTRY 
  
          EQ     B2,B0,EVXERR 
          JP     EVXERR1     EXIT VIA EXPRESSION PROCESS
  
  
 SSTAB    BSS 
          VFD    60/0LNULL
          VFD    60/0LBASIC 
          VFD    60/0LFORTRAN 
          VFD    60/0LFTNTS 
          VFD    60/0LEXECUTE 
          VFD    60/0LBATCH 
          VFD    60/0LACCESS
          VFD    60/0LTRANACT 
          VFD    60/0LUNDEFINED 
          BSSZ   1           END OF TABLE 
  
  
