ASMB,R,L,C
      HED "MKIDS" ROUTINE TO PUT SESSION STUFF IN IDSEGMENTS 4-78 (DLB) 
      NAM MKIDS,6 PRE-REL 780417 (DLB) RTE-IV 
      SPC 1 
      ENT MKIDS 
      EXT $OPSY,$LIBR,$LIBX,IDSGA,.XLA,.XSA 
      EXT .ENTP 
      SPC 1 
A     EQU 0 
B     EQU 1 
      SPC 1 
*  PURPOSE:  THIS ROUTINE SETS THE SESSION BIT IN WORD 21 
*            OF THE IDSEGMENT OF GIVEN PROGRAM.  IN RTE-IV
*            THE SESSION WORD (ID(XX)) IS SETUP WITH THE
*            NEGATIVE LU THAT IS PASSED TO THIS SUBROUTINE. 
* 
*  CALLED:
* 
*     JSB MKIDS 
*     DEF *+3 
*     DEF INAME    PROGENITORS PROGRAM NAME 
*     DEF LU       SESSION LOGICAL UNIT NUMBER
*     <RETURN>     A= IDSEGMENT ADDRESS OF PROGENITOR 
*                  A=0 IF UNSUCCESSFUL
      SPC 1 
PNAME NOP           PROGRAM NAME
LU    NOP           SESSION LOGICAL UNIT NUMBER 
MKIDS NOP           SESSION-FY THE PROGRAMS IDSEGMENT 
      JSB $LIBR     MAKE THIS A PRIVLEDGED SUBROUTINE 
      NOP 
      JSB .ENTP 
      DEF PNAME 
      LDA PNAME,I   GUARD AGAINST NULL NAME 
      SZA,RSS 
      JMP MKID2     ITS NOT NICE TO FOOL MOTHER-- 
      JSB IDSGA     FIND IDSEGMENT ADDRESS SO THAT
      DEF *+2 
      DEF PNAME,I   I CAN SET UP THE SESSION BIT
      SZA,RSS       NOTE: E-REG = 0 IF A#=0 !!! 
      JMP MKID2     IF SOMEHOW IT DISAPPEARED, GET OUT
      STA IDSEG     SAVE FOR EXIT 
      ADA D14       INDEX TO ID(15) TO GET
      STA B         SAVE IN B-REG 
      JSB .XLA      AND THE THE PROGRAM TYPE
      DEF A,I       CODE
      AND O17       MASK TO JUST PROGRAM TYPE WORD
      CPA O1        CHECK IF CORE-RESIDENT IN RTE-IV
      CCE           YES,SET FLAG FOR USE LATER
      ADB O6        BUMP TO STATUS FLAG WORD
      JSB .XLA
      DEF B,I       GET THE WORD 21 FROM IDSEGMENT
      IOR O20K      MIRGE IN THE SESSION BIT
      JSB .XSA
      DEF B,I       AND PUT BACK
      LDA DM9       CHECK IF RTE-IV?
      CPA $OPSY     ? 
      LDA LU,I      YES, GET THE TERMINAL LU
      CMA,SSA,INA,RSS  NEGATE & TEST IF RTE-IV? 
      JMP MKID1     NOT RTE-IV, SKIP
      ADB D8        INDEX TO SESSION WORD IF CORE-RES 
      SEZ,CLE,RSS   CHECK IF DISC RESIDENT PROGRAM? 
      ADB O4        YES, BUMP TO SESSION WORD FOR DISC RES-ID 
      JSB .XSA      AND STORE - LU IN ID
      DEF B,I 
MKID1 LDA IDSEG     GET THE IDSEGMENT VALUE 
MKID2 JSB $LIBX     TURN BACK ON INTERRUPT SYSTEM 
      DEF MKIDS     AND EXIT
      SPC 1 
IDSEG NOP           HOLDS PROGENITORS IDSEGMENT ADDRESS 
O1    OCT 1 
O4    OCT 4 
O6    DEC 6 
D8    DEC 8 
D14   DEC 14
O17   OCT 17
DM9   DEC -9
O20K  OCT 20000 
      END 
                                                                                                                                              