ASMB,R,L,C
*     NAME:   ACNAM 
*     SOURCE: 92067-18184 
*     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 ACNAM,7 92067-16125 REV.1903 790102 
      ENT ACNAM 
      EXT .ENTR     PARAMETER ADDRESS FETCH ROUTINE 
      EXT READF     FMP FILE READ ROUTINE 
      EXT POSNT     FMP FILE POSITION ROUTINE 
* 
*  ROUTINE TO FIND THE ACCOUNT NAME(S) ASSOCIATED WITH A
*  SESSION MONITOR PRIVATE OR GROUP ID
*  NOTE:  ASSUMES CALLER HAS OPENED AND WILL CLOSE ACCOUNT
*         FILE WITH SPECIFIED DCB 
* 
*  CALLING SEQUENCE:  JSB ACNAM 
*                     DEF *+7 
*                     DEF IDCB      ACCOUNT FILE DCB
*                     DEF ID        SESSION MONITOR ACCOUNT ID
*                     DEF PGS       1 (PRIVATE), 2 (GROUP) OR 3 (SYS) 
*                     DEF IREC      DIRECTORY ENTRY # 
*                     DEF BUF       11-WORD RETURN BUFFER FOR NAME
*                     DEF BUFL      # CHARS IN ACCT NAME IN BUF 
* 
*              NOTE:  IREC IS SET TO 1 BY CALLER ON FIRST CALL FOR
*                     A PARTICULAR ID.  ACNAM RETURNS NEXT
*                     DIRECTORY ENTRY NUMBER WITH MATCHING ID IN
*                     IREC.  IREC IS SET TO 0 WHEN LAST DIRECTORY 
*                     ENTRY WITH A MATCHING ID IS FOUND.
* 
* 
* ERRORS:  IREC = -1  FMP ERROR 
*               = -2  NO MATCH FOUND
*               = -3  BAD PARAMETER 
* 
* 
* METHOD:  IF PGS IS PRIVATE OR SYSTEM, SEARCH USER ENTRIES IN
*          ACCOUNT FILE DIRECTORY BEGINNING WITH DIRECTORY ENTRY
*          IREC.  IF PGS IS GROUP, SEARCH THE ACCOUNT FILE
*          DIRECTORY FOR GROUP ENTRIES.  IF A MATCHING ID 
*          IS FOUND, WRITE USER.GROUP OR GROUP NAME TO BUF. 
*          CONTINUE SEARCHING FOR MATCHING ID.  IF FOUND, RETURN
*          DIRECTORY ENTRY NUMBER IN IREC, ELSE RETURN IREC=0.
* 
* 
* 
IDCB  NOP           ACCOUNT FILE DCB
ID    NOP           SESSION ACCOUNT ID
PGS   NOP           1 IF PRIVATE, 2 IF GROUP, 3 IF SYSTEM 
IREC  NOP           DIRECTORY ENTRY NUMBER
BUF   NOP           RETURN BUFFER FOR ACCOUNT NAME
BUFL  NOP           LENGTH OF NAME IN CHARACTERS
ACNAM NOP           ENTRY 
      JSB .ENTR     GET PARAMETER ADDRESSES 
      DEF IDCB
      LDA ID,I      CHECK BOUNDS OF ID
      SSA,RSS       POSITIVE? 
      SZA,RSS       YES, ZERO?
      JMP ERR3      ERROR - ID IS NEGATIVE OR ZERO
      CMA,INA       LARGER THAN MAXIMUM ID? 
      ADA MAXID 
      SSA 
      JMP ERR3      ERROR, ID IS LARGER THAN MAXIMUM ID 
      LDA IREC,I    CHECK IREC PARAMETER
      SSA,RSS       MUST BE POSITIVE AND
      SZA,RSS       NON-ZERO
      JMP ERR3      NO, SO BAD PARAMETER
      LDA PGS,I     CHECK PGS PARAMETER 
      CLB 
      STB FFLAG     INITIALIZE THE FOUND FLAG 
      INB           SET UP B AS COMPARE WORD
      CPA B         PGS=1?
      JMP USER      YES, PRIVATE ID 
      INB 
      CPA B         PGS=2?
      JMP GROUP     YES, GROUP ID 
      INB 
      CPA B         PGS=3?
      RSS           YES, SEARCH FOR A USER ACCOUNT
      JMP ERR3      ERROR - PGS NOT 1,2 OR 3
USER  CCA,RSS       A IS SET TO SEARCH FOR USER ACCOUNTS
GROUP CLA           A IS ZERO TO SEARCH FOR GROUP ACCOUNTS
      STA ACTYP     SAVE TYPE OF ACCOUNT TO LOOK FOR
      JSB READF     READ ACCOUNT FILE HEADER
      DEF *+7 
      DEF IDCB,I    DCB 
      DEF IERR      ERROR WORD
      DEF IBUF      RETURN BUFFER 
      DEF .6        NUMBER OF WORDS TO READ 
      DEF IDMY
      DEF .1        RECORD #1 
      LDA IERR      GET ERROR WORD
      SSA           ERROR?
      JMP ERR1      YES, RETURN IREC=-1 
      CCB           GET DIRECTORY ENTRY NUMBER - 1
      ADB IREC,I
      CLA 
      LSR 3         DIVIDE BY 8 TO GET RECORD OFFSET
      ADB IBUF+4    ADD LOCATION OF START OF DIRECTORY
      STB JREC      SAVE IT FOR POSITION
      ALF,ARS       GET INDEX FOR CURRENT RECORD
      STA INDX      SAVE IT 
      ALF           COMPUTE WORD OFFSET INTO RECORD 
      ADA DEFIB 
      STA IPTR      SAVE IT 
      JSB POSNT     POSITION FOR FIRST READ 
      DEF *+5 
      DEF IDCB,I    DCB 
      DEF IERR      ERROR RETURN
      DEF JREC      RECORD NUMBER 
      DEF .1
      LDA IERR      GET ERROR WORD
      SSA           ERROR?
      JMP ERR1      YES, RETURN IREC=-1 
      JMP READ0     SKIP 1ST INCREMENT OF RECORD #
READ  ISZ JREC      INCREMENT RECORD #
      CLA 
      STA INDX      RESET INDEX INTO RECORD TO 0
READ0 JSB READF     READ NEXT RECORD FROM ACCOUNT FILE
      DEF *+4 
      DEF IDCB,I    DCB 
      DEF IERR      ERROR RETURN
      DEF IBUF      RETURN BUFFER 
      LDA IERR      GET ERROR WORD
      SSA           ERROR?
      JMP ERR1      YES, RETURN IREC=-1 
      LDA IPTR
      JMP READ3 
READ1 ISZ IREC,I    INCREMENT DIRECTORY ENTRY NUMBER
      LDA INDX      GET INDEX INTO CURRENT RECORD 
      CPA .7        DONE WITH THIS RECORD?
      RSS           YES 
      JMP READ2     NO, CONTINUE
      LDA DEFIB 
      STA IPTR      RESET POINTER TO START OF BUFFER
      JMP READ      READ NEXT RECORD
READ2 ISZ INDX      BUMP INDEX INTO THIS RECORD 
      LDA IPTR      GET POINTER INTO BUFFER 
      ADA .16       BUMP TO NEXT ENTRY
      STA IPTR      SAVE IT 
READ3 LDA A,I       GET FIRST WORD OF DIRECTORY ENTRY 
      CPA M1        FREE DIRECTORY ENTRY (MARKED AS -1)?
      JMP READ1     ITS FREE, SO JUST READ NEXT RECORD
      SZA,RSS       END OF DIRECTORY? 
      JMP EOF       YES 
      CLB 
      ASR 8 
      SZA           GROUP ENTRY (POSITIVE)? 
      CCA,CLE,RSS   NO, USER ENTRY - SET A FOR COMPARE
      CLA,CCE       YES, GROUP ENTRY - CLEAR A FOR COMPARE
      CPA ACTYP     IS IT THE TYPE WE'RE LOOKING FOR? 
      RSS           YES, SEE IF ID MATCHES
      JMP READ1     READ NEXT RECORD
      LDA IPTR      GET DIRECTORY ENTRY 
      SEZ           GROUP ENTRY?
      JMP GRPID     YES, GET GROUP ID FROM DIRECTORY ENTRY
      ADA .11       NO, GET USER ID FROM DIRECTORY ENTRY
      LDA A,I 
      CPA ID,I      COMPARE WITH ID PARAMETER 
      JMP FOUND     IT MATCHES
NEXTR JMP READ1     READ NEXT RECORD
GRPID ADA .12       GET GROUP ID FROM DIRECTORY ENTRY 
      LDA A,I 
      CPA ID,I      COMPARE WITH ID PARAMETER 
      RSS           YES 
      JMP NEXTR     NO, READ NEXT RECORD
FOUND LDA FFLAG     GET FOUND FLAG
      SZA           IF NOT FIRST FIND,
      JMP ACNAM,I   RETURN DIRECTORY ENTRY NUMBER AND EXIT
      LDA IPTR,I    GET NAME LENGTH WORD
      ELA,CLE,ERA   STRIP OFF SIGN BIT
      CLB 
      RRR 8         # CHARS IN USER NAME TO A 
      BLF,BLF       # CHARS IN GROUP NAME TO B
      STB GRPLN     SAVE LENGTH OF GROUP NAME 
      LDB BUF       GET ADDRESS FOR DESTINATION 
      STB PBUF      SAVE FOR UNPACK-PACK ROUTINE
      CLB 
      CPB ACTYP     GROUP ACCOUNT?
      JMP GRP       YES, JUST USE GROUP NAME LENGTH 
* 
      STA USRLN     SAVE LENGTH OF USER NAME
      ADA GRPLN     ADD LENGTH OF GROUP NAME
      INA           ADD 1 FOR NAME DELIMITER (".")
      STA BUFL,I    RETURN LENGTH (CHARS) IN BUFL 
      LDB IPTR      GET ADDRESS TO TRANSFER FROM
      INB 
      STB UPBUF     SAVE FOR UNPACK-PACK ROUTINE
      LDA B,I       GET USER NAME 
      ELA,CLE,ERA   STRIP SIGN BIT FROM USER NAME 
      STA B,I       REPLACE IT
      JSB PACKN     TRANSFER USER NAME TO BUFFER
      DEF USRLN     NUMBER OF CHARACTERS TO TRANSFER
      LDB PTR       GET ADDRESS TO TRANSFER FROM
      STB UPBUF     SAVE FOR UNPACK-PACK ROUTINE
      JSB PACKN     MOVE "." TO BUFFER
      DEF .1        LENGTH = 1 CHARACTER
MOVEG LDB IPTR      ADDRESS TO TRANSFER FROM
      ADB .6
      STB UPBUF     SAVE FOR UNPACK-PACK ROUTINE
      JSB PACKN     TRANSFER GROUP NAME TO BUFFER 
      DEF GRPLN     NUMBER OF CHARACTERS TO TRANSFER
* 
      ISZ FFLAG     SET THE FOUND FLAG
      CLA 
      CPA ACTYP     GROUP ACCOUNT?
      JMP EOF       YES, DONE - NEED NOT SEARCH FURTHER 
      JMP READ1     READ NEXT RECORD
GRP   LDB GRPLN     GET GROUP NAME LENGTH (CHARS) 
      STB BUFL,I    SAVE AS NAME LENGTH 
      JMP MOVEG     MOVE GROUP NAME 
EOF   LDA FFLAG     GOT TO END OF DIRECTORY 
      SZA           WAS A MATCH FOUND?
      CLA,RSS       YES, RETURN IREC=0
      LDA M2        ERROR -2, NO MATCHES FOUND
      RSS 
ERR1  CCA           ERROR -1, FMP ERROR 
      RSS 
ERR3  LDA M3        ERROR -3, BAD PARAMETER 
      STA IREC,I    RETURN ERROR CODE 
      SZA           IF ERROR, SET BUFL TO 0 
      CLB,RSS 
      RSS           NO ERROR, SO SKIP 
      STB BUFL,I
      JMP ACNAM,I   RETURN
* 
* 
*          STRING PACK ROUTINE
* 
*  THE FOLLOWING ROUTINE PACKS A CHARACTER INTO A BUFFER
*  ACCORDING TO THE POINTER PBUF WITHOUT OTHERWISE ALTERING 
*  THE BUFFER.  THE ROUTINE UPDATES PBUF SO THAT A PACKED 
*  ASCII BUFFER MAY BE WRITTEN BY SUCCESSIVE CALLS TO PAK.
*  PBUF CONTAINS THE ADDRESS OF THE WORD TO PACK INTO; THE
*  SIGN BIT, IF SET, INDICATES A PACK INTO THE LOW ORDER
*  BITS OF THE WORD.
* 
CHAR  BSS 1 
PAK   NOP           ENTRY 
      LDB PBUF      LOAD CURRENT ADDRESS POINTER
      CLE 
      ELB,RBR       GET SIGN BIT
      SEZ,RSS       TEST IF SIGN BIT SET
      ALF,ALF 
      STA CHAR
      LDA B,I       GET CONTENTS OF ASCII BUFFER
      SEZ 
      ALF,ALF 
      AND =B177     MASK HIGH BITS
      SEZ 
      ALF,ALF 
      XOR CHAR      GET ACTUAL CHARACTER
      STA B,I       PACK IN CURRENT PACK ADDRESS
      SEZ,CME       TEST IF SIGN BIT SET
      INB,RSS       YES, INCREMENT PACK ADDR
      ELB,RBR 
      STB PBUF      SAVE NEW ADDRESS POINTER
      JMP PAK,I     RETURN
* 
* 
*                  STRING UNPACK ROUTINE
* 
*  THE FOLLOWING ROUTINE UNPACKS A CHARACTER FROM A PACKED
*  ASCII BUFFER ACCORDING TO THE POINTER UPBUF.  THE ROUTINE
*  UPDATES UPBUF SO THAT A PACKED BUFFER MAY BE SEARCHED BY 
*  SUCCESSIVE CALLS TO UNPAK.  UPBUF CONTAINS THE ADDRESS OF
*  THE WORD TO UNPACK FROM; THE SIGN BIT, IF SET, INDICATES 
*  AN UNPACK FROM THE LOW ORDER BITS OF THE WORD. 
* 
UNPAK NOP           ENTRY 
      LDB UPBUF     LOAD CURRENT ADDRESS POINTER
      CLE 
      ELB,RBR       GET SIGN BIT
      LDA B,I       GET CONTENTS OF PACKED BUFFER 
      SEZ,RSS       TEST IF SIGN BIT SET
      ALF,ALF 
      AND =B177     MASK HIGH BITS
      SEZ,CME       TEST IF SIGN BIT SET
      INB,RSS       YES, INCREMENT UNPACK ADDR
      ELB,RBR 
      STB UPBUF     SAVE NEW ADDRESS POINTER
      JMP UNPAK,I   RETURN
* 
* 
*             CHARACTER UNPAK-PAK ROUTINE 
* 
*     THE FOLLOWING ROUTINE PERFORMS A SERIES OF UNPACK AND 
*     PACK OPERATIONS BASED ON THE INPUT PARAMETER N.  EACH 
*     UNPAK-PAK OPERATION TRANSFERS THE NEXT CHARACTER IN THE 
*     BUFFER POINTED TO BY UPBUF INTO THE NEXT CHARACTER
*     POSITION POINTED TO BY PBUF.
* 
*                         JSB PACKN 
*                         DEF N, WHERE N IS THE NUMBER OF 
*                         CHARACTERS TO BE TRANSFERRED
* 
CHARS BSS 1 
PACKN NOP 
      LDA PACKN,I 
      LDA A,I 
      CMA           SAVE CHARACTER COUNT - 1
      STA CHARS 
TESTN ISZ CHARS     ALL CHARACTERS TRANSFERRED? 
      RSS 
      JMP EXIT2     YES 
      JSB UNPAK     NO, UNPACK NEXT CHARACTER 
      JSB PAK       PACK THE CHARACTER INTO TO-BUFFER 
      JMP TESTN 
EXIT2 ISZ PACKN     INCREMENT RETURN ADDRESS
      JMP PACKN,I   RETURN
* 
A     EQU 0 
B     EQU 1 
.1    DEC 1 
.6    DEC 6 
.7    DEC 7 
.11   DEC 11
.12   DEC 12
.16   DEC 16
M1    DEC -1
M2    DEC -2
M3    DEC -3
MAXID OCT 7777      MAXIMUM SESSION MONITOR ACCOUNT ID
DOT   ASC 1,.       DELIMITER FOR USER.GROUP NAME 
PTR   DEF DOT 
ACTYP BSS 1         ACCT TYPE, 0=GROUP, -1=USER 
FFLAG BSS 1         FOUND FLAG, = 1 AFTER 1ST MATCH 
IBUF  BSS 128       BUFFER FOR ACCT FILE DIRECTORY READ 
DEFIB DEF IBUF
IDMY  BSS 1 
IPTR  BSS 1 
INDX  BSS 1 
PBUF  BSS 1         PACK-TO BUFFER, USED BY PAK ROUTINE 
UPBUF BSS 1         UNPACK-FROM BUFFER, USED BY UNPAK 
IERR  BSS 1         FMP ERROR RETURN WORD 
JREC  BSS 1         CURRENT RECORD POSITION IN ACCT FILE
GRPLN BSS 1         LENGTH OF GROUP NAME (CHARACTERS) 
USRLN BSS 1         LENGTH OF USER NAME  (CHARACTERS) 
      END 
                                      