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