ASMB,R,L,C,Q
*     NAME:   LSUB2 
*     SOURCE: 92067-18266 
*     RELPC:  92076-16260 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 LSUB2,8 92067-16260 REV.1903 790326 
* 
* 
      ENT INIT2,VALID,IDSCH,CLEAC,SQUZ,DADD,FCPU,DCNCT,NAMT 
      EXT SESID,SCBAD,INTER,NAM.. 
      EXT EXEC,IDRPD,MESSP
* 
* 
      EXT $LGOF,.ENTR,ISMVE,$SMCP,$SMID,$SMGP,$LIBR,$LIBX 
      EXT MESSS,$SMII,VSCBA,.DAD,.DMP,LCLAS,$DSCS,$SMD# 
* 
* 
* 
* 
A     EQU 0 
B     EQU 1 
KYWRD EQU 1657B 
D1    DEC 1 
D2    DEC 2 
D5    DEC 5 
B200  OCT 200 
B17   OCT 17
D18   DEC 18
B20K  OCT 20000 
* 
* 
      SPC 5 
* 
* 
* 
* 
* 
* 
* 
*  RETURNS LOG-OFF CLASS # OR 0 
* 
* 
INIT2 NOP 
      LDB INIT2,I   FETCH RETURN ADDR 
      ISZ INIT2     ADVANCE TO PARM LOC 
      LDA INIT2,I    AND FETCH ADDR OF PARM 
      STA INIT2 
      OCT 101724    FETCH ACCTS BUSY FLAG (XLA **ASSEMBLER BUG) 
      DEF $DSCS+1 
      STA INIT2,I    AND RETURN IT
* 
      XLA $DSCS     FETCH SESSION STATUS FLAG 
      SSA           IF NOT UP AND RUNNING 
      JMP B,I       RETURN STATUS IN (A)
* 
      LDA $LGOF     FETCH COMMUNICATION CLASS NUMBER FOR LGOFF
      SZA           IF NOT DEFINED, RETURN A ZERO 
      IOR B20K      ADD THE DON'T DEALLOCATE CLASS BIT
      STA LCLAS     DEFINE THE CLASS FOR MESSP AND
      JMP B,I       RETURN TO CALLER
* 
* 
      SPC 10
* 
* 
*  RETURNS A= 0 IF BAD PARMS
*          A= 1 IF OK 
* 
      SPC 5 
* 
CPU   NOP 
PID   NOP 
GID   NOP 
DENT  NOP 
* 
VALID NOP 
      JSB .ENTR     FET PARM ADDRESSES
      DEF CPU 
* 
      JSB VSCBA     GO VERIFY SCB ADDRESS (DEFINED IN COMMON) 
      DEF *+2 
      DEF SCBAD,I      RETURNS SESSION ID OR ZERO IN (A). 
* 
      CPA SESID,I   MUST MATCH SPECIFIED SESSION IDENTIFIER 
      JMP VAL1      OK--GO FETCH INFO FROM SCB
      CLA           RETURN A=0 FOR FAILURE
      JMP VALID,I   RETURN
* 
* 
VAL1  JSB ISMVE     GO FETCH CPU INFORMATION FROM SCB 
      DEF VAL2
      DEF SCBAD,I   READ FROM LOCATION DEFINED BY SCBAD 
      DEF $SMCP      USING THIS OFFSET
      DEF CPU,I     PLACE THE RESULT HERE 
      DEF D2        MOVE 2 WORDS
VAL2  EQU * 
* 
      JSB ISMVE 
      DEF VAL3
      DEF SCBAD,I   READ
      DEF $SMID      THE PRIVATE DISC ID FROM THE SCB 
      DEF PID,I     AND PUT IT HERE 
      DEF D1        DO 1 WORD 
VAL3  EQU * 
* 
      JSB ISMVE 
      DEF VAL4
      DEF SCBAD,I 
      DEF $SMGP     READ GROUP ID FROM SCB
      DEF GID,I     AND PUT IT HERE 
      DEF D1        DO ONE WORD 
VAL4  EQU * 
      JSB ISMVE 
      DEF VAL5
      DEF SCBAD,I 
      DEF $SMD#     FETCH DIRECTORY ENTRY NUMBER
      DEF DENT,I     FROM SCB AND PLACE IT HERE.
      DEF D1
VAL5  EQU * 
      CLA,INA       OK RETURN 
      JMP VALID,I    A = 1
* 
* 
      SPC 10
* 
* 
*  RETURNS A=0 IF END OF ID'S 
*          A=1 AND "OF, PGNAM ,8(OR ,1)" IF ACTIVE SESSION PGRM FOUND.
* 
* 
* 
IDNO  NOP 
OFPRG NOP 
* 
IDSCH NOP 
      JSB .ENTR 
      DEF IDNO
* 
NXID  LDB IDNO,I    FETCH STARTING ID # 
      ISZ IDNO,I    BUMP ID OFFSET FOR NEXT TIME
* 
      ADB KYWRD     ADVANCE TO ADDRESS OF NEXT ID 
      LDA B,I       FETCH THE ID ADDRESS
      SZA,RSS       IF END OF LIST
      JMP IDSCH,I     RETURN A=0
* 
      STA TEMP1     SAVE ID ADDR
      STA B         PREPARE FOR WALK THROUGH ID SEG 
      ADB D14       ADVANCE TO TYPE WORD
      LDA B,I         AND FETCH IT
      AND B20       ISOLATE SHORT SEGMENT BIT 
      SZA             AND CHECK IT
      JMP DONE       IF SHORT SEG, ALL DONE 
* 
      ADB D18       ADVANCE TO SESSION WORD 
      LDA B,I        AND FETCH IT 
      CPA SCBAD,I   SAME AS SESSION LOGGING OFF ? 
      JMP ACTID     YES-
* 
      JMP NXID      GO TRY THE NEXT ONE 
* 
ACTID LDA OFPRG     FETCH ADDRESS OF NAME BUFFER
      LDB TEMP1     FETCH ID ADDRESS
      JSB SNAM      GO SET UP "OF, PROGM ,8" ((B) IS SAVED) 
* 
      ADB D31       ADVANCE TO ID OWNER FLAG (LOW BYTE WD 31) 
      LDA B,I       FETCH 
      AND B377         AND ISOLATE IT 
      CPA SESID,I   IF SESSION LOGGING OFF OWNS THE ID
      JMP OUT               GO EXIT 
* 
      LDA OFPRG     THE SESSION DOESN'T OWN THIS ONE
      ADA D5           SO REPLACE THE "OF,PRG,8" WITH 
      LDB C1              "OF,PRG,1"
      STB A,I 
* 
OUT   CLA,INA,RSS   ACTIVE PROGRAM FOUND, RETURN A=1
DONE  CLA           NO ACTIVE PROGRAMS FOUND, RETURN A=0
      JMP IDSCH,I 
* 
      SPC 10
TEMP0 NOP 
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
D14   DEC 14
KYPNT NOP 
D32   DEC 32
B20   OCT 20
N1    DEC -1
ND14  DEC -14 
RE    ASC 2,REMO
VE    ASC 2,VED 
WHR   OCT 10001 
B40   OCT 40
HBYTE OCT 177400
B377  OCT 377 
D31   DEC 31
D12   DEC 12
* 
* 
* 
CLEAC NOP 
      LDA CLEAC,I   FETCH RETURN ADDRESS
      STA CLEAC       AND SAVE FOR EXIT 
* 
      LDB KYWRD     FETCH TOP OF ID SEGMENT LIST
      STB TEMP0     SAVE FOR NEXT TIME
      LDB B,I       FETCH FIRST ID
* 
CL.2  STB KYPNT     SAVE CURRENT ADDRESS
      SZB,RSS       CHECK FOR END OF LIST 
      JMP CLEAC,I   IF DONE-- GET OUT 
* 
      ADB D14       ADVANCE TO ID TYPE WORD AND LAST CHAR OF NAME 
      LDA B,I       SEE IF ANYONE IS HOME 
      AND B200      MUST BE A TEMP LOAD 
      SZA,RSS       IF TEMP LOAD BIT NOT SET
      JMP NEXT        DON'T BOTHER WITH THIS ID 
      LDA B,I       ISOLATE SHORT SEGMENT BIT (#4)
      AND B20        IF SHORT SEGMENT 
      SZA 
      JMP CLEAC,I        WERE ALL DONE
* 
      LDA B,I       ONE LAST CHECK
      AND B17       ISOLATE TYPE
      CPA D5        CHECK FOR SHORT SEG IN LONG ID
      JMP NEXT      TRY NEXT ONE
* 
      LDB KYPNT     FETCH CURRENT ID ADDRESS
      LDA DKBUF     FETCH ADDRESS OF "OF " BUFFER 
      JSB SNAM      GO SET UP "OF, PRGRM,8" (B RETURNED UNCHANGED)
* 
      ADB D31       ADVANCE TO ID OWNER FLAG
      LDA B,I         AND FETCH IT
      AND B377      NOW SEE IF IT BELONGS 
      CPA SESID,I      TO THIS SESSION
      INB,RSS       IT BELONGS TO US -- ADVANCE TO CURRENT SESSION WORD 
      JMP NEXT      NOT OURS -- GO CHECK THE NEXT ONE 
* 
* 
*  AT THIS POINT, NONE OF THIS SESSION'S PROGRAMS MAY BE ACTIVE (THE
*  ROUTINE IDSCH TOOK CARE OF THAT). THEREFORE, ID 32 MUST BE ZERO (AS
*  IT IS CLEARED BY THE OP-SYSTEM UPON GOING DORMAT), UNLESS ANOTHER
*  SESSION IS USING THE ID. IF THIS IS THE CASE, THE ID IS GIVEN TO 
*  THE SESSION CURRENTLY USING THE ID.
* 
* 
      LDA B,I       FETCH SESSION WORD
      SZA           IS SOMEONE ELSE USING THIS PROGRAM ?
      JMP GIFT         YES -- SO GIVE IT TO THEM
* 
KILL  JSB IDRPD 
      DEF ID.1D     RELEASE THE ID
      DEF KNAM
ID.1D EQU * 
      SZA,RSS       WAS THE RELEASE OK ?
      JMP TRKS      YES- GO GIVE UP ANY TRACKS HE MAY HAVE OWNED
* 
* 
      JSB MESSS     GO REMOVE THE ID FROM THE SYSTEM
      DEF KRTN
      DEF KBUF      KILL BUFFER 
      DEF D12 
KRTN  EQU * 
* 
TELL DLD RE         ISSUE 
      DST KNAM+3      PROG REMOVED
      DLD VE        TO SESSION
      DST KNAM+5      TERMINAL
      JSB MESSP 
      DEF MESS1 
      DEF WHR 
      DEF KNAM
      DEF ND14
MESS1 EQU * 
* 
NEXT ISZ TEMP0      ADVANCE KYWRD POINTER 
      LDB TEMP0,I FETCH NEXT POSSIBLE ID ADDRESS
      JMP CL.2      GO TRY NEXT ONE 
* 
* 
TRKS  JSB EXEC
      DEF ID.2D 
      DEF D5
      DEF N1
ID.2D EQU * 
      JMP TELL
* 
* 
      SPC 5 
* 
* 
*  NOTE B=ID 32 ADDRESS 
* 
* 
GIFT  JSB $LIBR     GO PRIV 
      NOP 
* 
      LDA B,I       MAKE SURE PROGRAM IS
      SZA           STILL ACTIVE TO DIFFERENT SESSION 
      JMP GIFT2       STILL ACTIVE -- MAKE A GIFT OF IT 
* 
      JSB $LIBX     NOPE -- HE MUST HAVE JUST FINISHED
      DEF *+1 
      DEF KILL      GO KILL THE ID
* 
* 
GIFT2 ADB N1        BACK UP TO ID 31
      STB TEMP2     SAVE FOR UPDATING 
* 
      SSA           CHECK FOR POSSIBLE MTM USER 
      JMP MTM 
* 
      STA TEMP1     SAVE SCB ADDRESS FOR FETCH
* 
      JSB ISMVE 
      DEF GIFT3 
      DEF TEMP1     READ FROM LOCATION DEFINED HERE 
      DEF $SMII     OFFSET BACK TO SESSION IDENTIFIER 
      DEF TEMP1     PUT IT THERE
      DEF D1        MOVE ONE WORD 
GIFT3 EQU * 
* 
      LDA TEMP1     FETCH SESSION ID
      AND B377        ISOLATE 
GIFT4 STA TEMP1     AND SAVE FOR UPDATING ID SEGMENT
* 
      LDA TEMP2,I   FETCH CURENT OWNER FLAG (ID 31) 
      AND HBYTE     CLEAR OWNER FLAG
      IOR TEMP1     THEN UPDATE WITH NEW OWNER ID 
      STA TEMP2,I 
* 
      JSB $LIBX 
      DEF *+1 
      DEF NEXT
* 
* 
MTM   CLA           ID GOES BACK TO THE SYSTEM
      JMP GIFT4 
* 
* 
* 
* 
      SPC 10
* 
*  NOTE: (B) MUST BE RETURNED UNCHANGED 
* 
* 
* 
SNAM  NOP 
      STA TEMP2     SAVE BUFFER ADDRESS 
      STB TEMP3     SAVE ID ADDRESS 
* 
      DLD OF        FETCH ASCII "OF, "
      DST TEMP2,I    AND DUMP IT INTO USER BUFFER 
      ISZ TEMP2     ADVANCE BUFFER POINTER
      ISZ TEMP2     ADVANCE BUFFER POINTER
* 
      LDA TEMP3     FETCH ID ADDRESS
      ADA D12       ADVANCE TO FIRST WORD OF NAME 
      LDB A,I       FETCH IT
      STB TEMP2,I   AND DROP IT IN
      INA           ADVANCE TO LAST TWO WORDS OF NAME 
      ISZ TEMP2     BUMP BUFFER POINTER 
      DLD A,I       FETCH LAST TWO WORDS
      STA TEMP2,I   SET SECOND WORD INTO BUFFER 
      ISZ TEMP2     ADVANCE TO LAST WORD OF NAME
      LDA B         MOVE FINAL CHARACTER TO (A) 
      AND HBYTE     SAVE THE HIGH BYTE ONLY 
      ADA B40       ADD ASCII BLANK FOR LOW BYTE
      STA TEMP2,I 
      ISZ TEMP2     BUMP TO WORD 6 OF BUFFER
      LDA C8        ADD ",8" TO 
      STA TEMP2,I       MESSAGE BUFFER
      LDB TEMP3     RESTORE ID ADDRES 
      JMP SNAM,I    EXIT
* 
DKBUF DEF KBUF
OF    ASC 2,OF, 
KBUF  BSS 9         MINIMUM BUFFER SIZE 
C8    ASC 1,,8
C1    ASC 1,,1
* 
KNAM  EQU KBUF+2
      SKP 
* 
* 
* 
*  CALL DADD( ARG1 &RESULT ADDR, ARG2 ) 
* 
RSLT  NOP 
ARG2  NOP 
DADD  NOP 
      JSB .ENTR 
      DEF RSLT
* 
      DLD RSLT,I    FETCH OLD VALUE 
      JSB .DAD      GO DO DOUBLE WORD ADD 
      DEF ARG2,I
      DST RSLT,I    SAVE RESULT BACK
      JMP DADD,I    RETURN
* 
      SPC 5 
* 
*  CALL DCNCT(DSEC,HRS,DYS) 
* 
* 
DSEC  NOP 
HRS   NOP 
DYS   NOP 
DCNCT NOP 
      JSB .ENTR 
      DEF DSEC
* 
      CLA           CLEAR HIGH BITS 
      LDB DYS,I     FETCH CONNECT DAYS OF THIS SESSION
      JSB .DMP
      DEF DYSEC     NUMBER OF SECONDS IN A DAY
* 
      DST RSLT      SAVE THE RESULT IN TEMPS
* 
      CLA           CLEAR HIGH BITS 
      LDB HRS,I     FETCH CONNECT HOURS 
      JSB .DMP      CALULATE SECONDS
      DEF D3600      (NUMBER OF SECONDS IN 1 HOUR)
* 
      JSB .DAD      ADD NUMBER OF DAYS (IN SECONDS) 
      DEF RSLT
* 
      JSB .DAD      ADD CONNECT SECONDS 
      DEF DSEC,I
* 
      DST DSEC,I    RETURN RESULT 
      JMP DCNCT,I 
* 
* 
      SPC 5 
* 
* 
*  CALL FCPU(DOUBLE WORD 10'S OF MS, 4 WORD BUFFER FOR RESULT)
* 
DCPU  NOP 
RBUF  NOP 
FCPU  NOP 
      JSB .ENTR 
      DEF DCPU
* 
      DLD DCPU,I    FETCH CPU USAGE 
      SWP 
      DIV D6000      A=MIN, B=SEC & 10'S OF MS
      STB RSLT      SAVE SEC AND MS 
      CLB 
      DIV D60       NOW GET # HOURS 
      STA RBUF,I     AND RETURN IT
* 
      ISZ RBUF      MOVE TO MINUTES 
      STB RBUF,I    AND RETURN THEM 
* 
      ISZ RBUF      ADVANCE TO SECONDS
      CLB 
      LDA RSLT
      DIV D100      GET # OF SEC AND 10'S OF MS 
      STA RBUF,I    SET SECONDS 
      ISZ RBUF
      STB RBUF,I    SET MS
      JMP FCPU,I
* 
* 
D100  DEC 100 
D6000 DEC 6000
D60   DEC 60
*************** DOUBLE INTEGER FORMAT 
D3600 NOP 
      DEC 3600
*************** 
********************
DYSEC OCT 1   DEC 86400 
      OCT 50602 
********************
* 
* 
      SKP 
* 
BUF   NOP 
CNT   NOP 
SQUZ  NOP 
      JSB .ENTR 
      DEF BUF 
* 
      LDA CNT,I 
      CMA,INA 
      STA CNT 
* 
*     IF NOTHING PASSED, GET OUT
* 
      SZA,RSS       GOT ANYTHING  ? 
      JMP SQUZ,I      NO SO GET OUT ! 
* 
      LDB BUF 
      CLE,ELB 
* 
NXT   LBT 
      CPA N 
      JMP SQUZ,I
* 
      ISZ CNT 
      JMP NXT 
      JMP SQUZ,I
N     OCT 116 
* 
      SPC 5 
* 
* 
*  PROVIDES AN INTERFACE TO NAM.. FOR LGOFF 
* 
* 
NAMT1 NOP 
NAMT  NOP 
      JSB .ENTR 
      DEF NAMT1 
* 
      JSB NAM.. 
      DEF NAM.1 
      DEF NAMT1,I 
NAM.1 EQU * 
* 
      JMP NAMT,I
* 
      END