ASMB,R,L,C
      HED "ICAPS" ROUTINE TO GET THE CURRENT SESSION'S CAPABILITY 
*     NAME:   ICAPS 
*     SOURCE: 92067-18156 
*     RELOC:  92067-16125 
*     PGMR:   B.L.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
      NAM ICAPS,7 92067-16125 REV.1903 781213 
      ENT ICAPS 
      EXT SESSN     DETERMINES IF PROGRAM IS IN SESSION 
      EXT $SMVE     MOVES DATA TO/FROM SESSION CONTROL BLOCK (SCB)
      EXT $SMCA     CAPABILITY WORD OFFSET IN SCB 
      SPC 1 
* 
* ROUTINE TO OBTAIN THE CURRENT SESSION'S CAPABILITY LEVEL
* 
* CALLING SEQUENCE:   ICAP=ICAPS(DUMMY) 
*          <RETURN>   ICAP=SESSION'S CAPABILITY LEVEL 
*                         =0 IF CALLING PROGRAM NOT IN SESSION
* 
* METHOD:  THIS ROUTINE FIRST DETERMINES IF THE CALLING PROGRAM IS
*          IN SESSION MODE.  IF IT IS, THE CAPABILITY WORD FROM THE 
*          SESSION CONTROL BLOCK IS RETRIEVED AND RETURNED AS THE 
*          VALUE OF ICAPS.
* 
      SPC 1 
ICAPS NOP           ENTRY 
      JSB SESSN     DETERMINE IF PROGRAM IS IN SESSION
      DEF *+2 
      DEF XEQT      ID SEGMENT ADDRESS OF CURRENT PROGRAM 
      SEZ           IN SESSION? 
      JMP NSESN     NO, SET ICAPS=0 
      STB ISESN     YES, SAVE SESSION WORD FROM SESSN 
      JSB $SMVE     MOVE CAPABILITY WORD FROM SCB 
      DEF *+6 
      DEF .1        READ
      DEF ISESN     ID SEGMENT SESSION WORD 
      DEF $SMCA     CAPABILITY WORD OFFSET IN SCB 
      DEF ISESN     RETURN CAPABILITY LEVEL HERE
      DEF .1        NUMBER OF WORDS TO MOVE = 1 
      LDA ISESN     RETURN ICAPS=CAPABILITY LEVEL 
      RSS 
NSESN CLA           RETURN ICAPS=0 (NON-SESSION)
      LDB ICAPS,I   GET THE RETURN ADDRESS
      JMP B,I       RETURN
      SPC 1 
.1    DEC 1 
XEQT  EQU 1717B     ID SEGMENT ADDRESS OF CURRENT PROGRAM 
ISESN NOP 
A     EQU 0 
B     EQU 1 
      END 
                                                            