ASMB,R,Q,C
      HED ACCOUNT NAME PARSE ROUTINE
* 
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
*     SOURCE PART NUMBER : 92067-18452
* 
*     RELOCATABLE PART NUMBER : 92067-16125 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
      NAM PARSN,7 92067-16125 REV.1940 790801 
* 
* 
*     PARSN IS A ROUTINE TO PARSE A SESSION MONITOR ACCOUNT NAME
*     OR PASSWORD.  IT USES A SUBROUTINE CALLED CHECK WHICH 
*     DETERMINES WHETHER A CHARACTER IS A VALID CHARACTER FOR AN  
*     ACCOUNT NAME OR PASSWORD.  PARSN SCANS THE COMMAND INPUT
*     UNTIL A COMMA, THE END OF THE BUFFER, OR A COMMENT
*     (INDICATED BY AN ASTERISK) IS REACHED.  ASCII BLANKS
*     ARE IGNORED.  INVALID CHARACTERS CAUSE AN ERROR RETURN. 
*     THE RESULT OF THE PARSE IS RETURNED IN A 11-WORD BUFFER:
*          WORD 1:    BITS 0-7  = CHARS IN GROUP NAME 
*                     BITS 8-15 = CHARS IN USER NAME
*          WDS 2-6:   USER NAME,  PADDED WITH BLANKS
*          WDS 7-11:  GROUP NAME, PADDED WITH BLANKS
* 
*     THE VARIABLE "LIMIT" DETERMINES THE LENGTH OF THE PARSE OUTPUT
*     TO BE ALLOWED.  ICHAR IS UPDATED TO INDICATE THE NEXT 
*     CHARACTER POSITION AT WHICH TO BEGIN THE NEXT PARSE, JUST 
*     AS THE ROUTINE NAMR DOES (ICHAR MUST BE DEFINED AS A VARIABLE). 
* 
*     CALLING SEQUENCE:  CALL PARSN (PBUF,UPBUF,LENTH,ICHAR,IERR) 
*                WHERE
*                        PBUF = PARSE OUTPUT BUFFER 
*                        UPBUF= PARSE INPUT BUFFER
*                        LENTH= NUMBER OF CHARS IN INPUT BUFFER 
*                        ICHAR= NEXT CHARACTER POSITION AT WHICH TO PARSE 
*                        IERR = ERROR RETURN WORD 
* 
*     ERRORS:              -1 = ICHAR > LENTH 
*                           1 = NAME TOO LONG 
*                           2 = INVALID CHARACTER(S) IN NAME
      SKP 
* 
* 
*     TEST PROGRAM: 
* 
*     FTN4,L
*           PROGRAM CKPAR 
*           DIMENSION IB(40),JB(11) 
*           DATA IB/40*2H  /
*           LU=LOGLU(IDMY)
*         1 WRITE(LU,100) 
*       100 FORMAT(" PLEASE ENTER STRING TO PARSE") 
*           READ(LU,200)(IB(I),I=1,40)
*       200 FORMAT(40A2)
*           ICHAR=1 
*         2 CALL PARSN(JB,IB,40,ICHAR,IERR) 
*           NCHRU=JB(1)/256 
*           NCHRG=IAND(JB(1),377B)
*           WRITE(LU,300)NCHRU
*       300 FORMAT(1X,"NUMBER OF CHARS IN USER NAME = ",I2) 
*           WRITE(LU,500)(JB(J),J=2,6)
*           WRITE(LU,400)NCHRG
*       400 FORMAT(1X,"NUMBER OF CHARS IN GROUP NAME = ",I2)
*           WRITE(LU,500)(JB(J),J=7,11) 
*       500 FORMAT(1X,"WORD 1 = ",A2/ 
*          A       1X,"WORD 2 = ",A2/ 
*          B       1X,"WORD 3 = ",A2/ 
*          C       1X,"WORD 4 = ",A2/ 
*          D       1X,"WORD 5 = ",A2/)
*           WRITE(LU,600)IERR,ICHAR 
*       600 FORMAT(1X,"ERROR = ",I2,5X,"NEXT CHAR POSITION = ",I2//)
*           IF (ICHAR.LE.80) GO TO 2
*           STOP
*           END 
      SKP 
      ENT PARSN 
      EXT .ENTR 
* 
PBUF  NOP 
UPBUF NOP 
LENTH NOP 
ICHAR NOP 
IERR  NOP 
PARSN NOP           ENTRY 
      JSB .ENTR     GET PARAMETER ADDRESSES 
      DEF PBUF
      LDA COMMA     SET ALTERNATE TERIMINATOR TO COMMA
      STA ALTRM 
      CLA 
      STA NONBL     CLEAR NON-BLANK CHARACTER COUNT 
      LDB PBUF      GET OUTPUT BUFFER ADDRESS 
      STA B,I       CLEAR OUTPUT CHARACTER COUNT
      STB CNTWD     SAVE ADDRESS OF 1ST WD OF OUTPUT BUFFER 
      INB           BUMP TO WORD 2 OF OUTPUT BUFFER 
      STB PBUF      SAVE FOR PAK ROUTINE
      LDA LIMIT     GET OUTPUT BUFFER LENGTH
      STA TEMP      SAVE FOR COUNTING WORDS TO BLANK
      LDA BLNKS     GET ASCII BLANKS
CLEAR STA B,I       INITIALIZE OUTPUT BUFFER WITH BLANKS
      INB           BUMP OUTPUT BUFFER ADDRESS
      ISZ TEMP      BUMP COUNT OF WORDS LEFT TO BE BLANKED
      JMP CLEAR     MORE, SO CONTINUE 
      LDA ICHAR,I   DONE, NOW GET STARTING CHAR POSITION
      ADA M1        GET OFFSET FROM START OF INPUT BUFFER 
      ARS           CONVERT TO WORDS
      ADA UPBUF     ADDRESS AT WHICH TO START PARSE 
      LDB ICHAR,I   CHARACTER POSITION
      CLE,SLB,RSS   IF CHARACTER POSITION EVEN, 
      CCE           THEN SET THE LOW BYTE FLAG
      ELA,RAR       SET SIGN BIT IF TO START AT LOW BYTE
      STA UPBUF       OF INPUT BUFFER 
      LDB LENTH,I   GET LENGTH OF INPUT BUFFER FOR EOB CHECK
      SZB,RSS       IF LENGTH IS ZERO,
      JMP OK        THEN DONE 
      SSB,RSS       IF LENGTH IS POSITIVE,
      CMB,INB       MAKE NEGATIVE 
SCAN1 ADB ICHAR,I   CHECK IF ICHAR > LENGTH (IN CHARACTERS) 
      CCA 
      SSB           POSITIVE? 
      JMP SCAN2     NO, SO ICHAR NOT > LENGTH 
      SZB           ZERO? 
      JMP ERROR     ERROR RETURN (ICHAR>LENGTH IN CHARS)
SCAN2 ADB A         SET UP REMAINING CHARS IN INPUT BUFFER
      STB INCNT     SAVE IT 
      LDA LIMIT     SET UP LIMIT FOR PARSE OUTPUT 
      STA OUTCT 
      LDB M2        INITIALIZE COUNT OF ASCII DOTS FOUND
      STB DOTCT     SAVE IT 
      STB ATCNT     INITIALIZE COUNT OF "@"'S FOUND 
      STB ENDP      END OF PARSE INDICATOR
      RSS           SKIP FIRST ISZ
NEXTC ISZ INCNT     CHECK FOR END OF BUFFER 
      RSS           NOT END OF BUFFER 
      JMP ENPAR     END OF BUFFER, SO DONE
      JSB UNPAK     GET NEXT CHARACTER
      ISZ ICHAR,I   BUMP CHARACTER POSITION 
      CPA BLANK     ASCII BLANK?
      JMP NEXTC     YES, SKIP IT AND GET NEXT CHARACTER 
      CPA COMMA     COMMA?
      JMP ENPAR     YES, DONE WITH PARSE
      CPA ALTRM     CHECK ALTERNATE TERMINATOR
      JMP ENPAR 
      CPA STAR      ASTERISK? (COMMENT) 
      JMP COMNT     YES 
      CPA DOT       ASCII DOT?
      JMP CKDOT     YES, CHECK IF VALID TO HAVE A DOT 
      CPA AT        "@"?
      JMP CHKAT     YES, CHECK IF VALID TO HAVE AN "@"
      JSB CHECK     CHECK FOR VALID CHAR FOR NAME/PASSWORD
      JMP E2        ERROR RETURN - INVALID CHARACTER
      LDA ATCNT     GET COUNT OF "@"'S FOUND
      CPA M1        IF ALREADY 1, 
      JMP E2        ERROR - "@" FOLLOWED BY ANOTHER CHAR
VALID JSB PAK       VALID CHARACTER - PUT INTO OUTPUT BUFFER
      ISZ CNTWD,I   BUMP OUTPUT CHARACTER COUNT 
      ISZ OUTCT     BUMP LIMIT CHECK FOR OUTPUT 
      JMP NEXTC     NOT TO LIMIT YET, GET ANOTHER CHARACTER 
      JSB SKIPC     SKIP CHARACTERS UNTIL EOB OR COMMA
      JMP E1        MORE NON-BLANK CHARS (EXCEEDED LIMIT) 
      RSS 
ENPAR ISZ ENDP
OK    JSB IFDOT     CHECK IF "NAME." FORMAT 
      JMP E2        YES, SO INVALID NAME
      CLA           EOB OR COMMA OR COMMENT, SO DONE
ERROR STA IERR,I    RETURN IN ERROR WORD
      JSB SETLN     SET CHAR COUNTS IN OUTPUT BUFFER
      JMP PARSN,I   RETURN
E1    CLA,INA 
      JMP ERROR 
E2    JSB SKIPC     SKIP CHARACTERS UNTIL EOB OR COMMA
      NOP           IGNORE ERROR 1, SINCE WE HAVE ERROR 2 
      LDA .2        ERROR, INVALID CHARACTER IN NAME
      JMP ERROR     RETURN THE ERROR 2
      SPC 1 
SKIPC NOP           ENTRY, SKIP CHARACTER ROUTINE 
SKIP0 LDA OUTCT     CHECK IF OUTPUT LIMIT ALREADY REACHED 
      SSA,RSS 
      JMP SKIP1     LIMIT REACHED 
      LDA ENDP
      CPA M1
      JMP SKIP3 
      JSB PAK       PUT CHARACTER INTO OUTPUT BUFFER
      ISZ CNTWD,I   INCREMENT OUTPUT CHARACTER COUNT
      ISZ OUTCT     INCREMENT LIMIT CHECK FOR OUTPUT
      NOP 
SKIP1 ISZ INCNT     SKIP CHARACTERS UNTIL EOB OR COMMA
      RSS           NOT END OF BUFFER 
      JMP SKIP3     END OF BUFFER, SO DONE
      JSB UNPAK     GET ANOTHER CHARACTER 
      ISZ ICHAR,I   BUMP CHARACTER POSITION 
      CPA BLANK     BLANK?
      JMP SKIP1     JUST CONTINUE WITH ANOTHER CHARACTER
      CPA COMMA     COMMA?
      JMP SKIP3     YES, SO DONE
      CPA ALTRM     CHECK ALTERNATE TERM
      JMP SKIP3 
      LDB NONBL     IF NO NONBLANK CHARACTERS CHECK FOR DOT 
      SZB 
      JMP SKIP2 
* 
      CPA DOT       CHECK DOT 
      JMP CKDOT 
SKIP2 ISZ NONBL     BUMP NON-BLANK CHARACTER COUNT
      JMP SKIP0     CONTINUE SKIPPING UNTIL EOB OR COMMA
SKIP3 LDA NONBL     CHECK IF NON-BLANK CHAR COUNT NON-ZERO
      SZA,RSS       IF SO,ERROR RETURN (P+1), A=NONBL COUNT 
      ISZ SKIPC     RETURN TO P+2, A=0
      JMP SKIPC,I   RETURN
      SPC 1 
CKDOT LDA SLASH     SET ALTERNATE TERMINATOR TO SLASH 
      STA ALTRM 
      LDA CNTWD,I   GET COUNT OF CHARS PARSED 
      SZA,RSS       IF NONE, THEN 
      JMP E2        ERROR - DOT IS INVALID
      ISZ DOTCT     ELSE CHECK IF MORE THAN ONE DOT 
      RSS           NO, ASSUME DOT IS SEPARATOR 
      JMP E2        YES, ERROR - DOT IS INVALID 
      ALF,ALF       MOVE # CHARS IN USER NAME TO UPPER BYTE 
      STA CNTWD,I   SAVE IT 
      LDA CNTWD     UPDATE OUTPUT BUFFER POINTER TO 
      ADA .6        WORD 6 OF OUTPUT BUFFER 
      STA PBUF      AND SAVE IT FOR PAK ROUTINE 
      LDA LIMIT     RESET OUTPUT BUFFER COUNT FOR GROUP NAME
      STA OUTCT     SAVE IT 
      LDA M2        RESET COUNT OF "@"'S FOR GROUP
      STA ATCNT     SAVE IT 
      JMP NEXTC     CONTINUE PARSE, THIS TIME FOR GROUP NAME
      SPC 1 
CHKAT LDA CNTWD,I   GET COUNT OF CHARACTERS PARSED
      AND B377      COUNT FOR PART OF NAME NOW BEING PARSED 
      SZA           IF NON-ZERO,
      JMP E2        ERROR - CAN'T ALLOW AN "@"
      ISZ ATCNT     BUMP COUNT OF "@"'S FOUND 
      JMP VALID     ALLOW 1ST "@" FOUND SINCE NO OTHER CHARS
      SPC 1 
COMNT LDA LENTH,I   GET LENGTH OF INPUT BUFFER
      SSA           IF NEGATIVE MAKE POSITIVE 
      CMA,INA 
      INA           RETURN NEXT CHAR POSITION=LAST CHAR 
      STA ICHAR,I   POSITION OF INPUT BUFFER, PLUS 1
      JMP OK
      SPC 1 
SETLN NOP           SET UP CHAR COUNTS IN OUTPUT BUFFER 
      LDA CNTWD,I   GET CHARACTER COUNT WORD
      LDB DOTCT     GET COUNT OF ASCII DOTS FOUND 
      CPB M2        IF NONE FOUND (COUNT STILL = -2)
      ALF,ALF       THEN SHIFT CHAR COUNT TO UPPER BYTE 
      STA CNTWD,I   SAVE IT 
      JMP SETLN,I   RETURN
      SPC 1 
IFDOT NOP           CHECK FOR "NAME." FORMAT
      LDA DOTCT     COUNT OF NUMBER OF ASCII DOTS FOUND 
      CPA M2        EVER FOUND A DOT? 
      JMP ALLOW     NO, SO ALLOW
      LDA CNTWD,I   YES, SO BETTER HAVE A CHARACTER AFTER 
      AND B377        THE DOT 
      SZA           IF YES, 
ALLOW ISZ IFDOT     THEN ALLOW (RETURN P+2) 
      JMP IFDOT,I   RETURN
      SKP 
* 
* 
*     ROUTINE TO CHECK IF A CHARACTER IS VALID FOR ACCT NAME/PASSWORD 
* 
* 
CHECK NOP           ENTRY 
      STA B         SAVE CHARACTER
      CMA,INA 
      ADA .126
      SSA           GREATER THAN 176B?
      JMP CHECK,I   YES, INVALID
      CMA,INA 
      ADA .78 
      SSA 
      JMP CHEC1     LESS THAN 60B?
      CPA .10       IS IT 72B (COLON)?
      RSS           YES 
      CPA .16       IS IT 100B (@)? 
      RSS           YES 
      ISZ CHECK     BETWEEN 60B & 176B, AND NOT COLON OR @, 
      JMP CHECK,I   SO IT'S VALID 
CHEC1 CMB,INB 
      ADB .41 
      SSB           GREATER THAN 51B? 
      JMP CHECK,I   YES,INVALID 
      CMB,INB 
      ADB .8
      SSB,RSS       LESS THAN 41B?
      ISZ CHECK     NO, BETWEEN 41B AND 51B, SO IT'S VALID
      JMP CHECK,I   RETURN
      SPC 1 
      SKP 
* 
* 
*     STRING UNPACK ROUTINE 
* 
* 
UNPAK NOP           ENTRY 
      LDB UPBUF     ADDRESS TO UNPACK FROM, - IF LOW BYTE 
      CLE 
      ELB,RBR       GET SIGN BIT
      LDA B,I       GET CONTENTS OF PACKED BUFFER 
      SEZ,RSS       TEST IF SIGN BIT SET
      ALF,ALF       NO, SHIFT HIGH BYTE TO LOW BYTE 
      AND =B177     MASK HIGH BYTE
      SEZ,CME       TEST IF SIGN BIT SET
      INB,RSS       YES, INCREMENT UNPACK ADDRESS 
      ELB,RBR 
      STB UPBUF     UPDATE ADDRESS OF UNPACK BUFFER 
      STA CHAR      SAVE FOR PAK ROUTINE
      JMP UNPAK,I   RETURN
      SPC 3 
* 
* 
*     STRING PACK ROUTINE 
* 
* 
PAK   NOP           ENTRY 
      LDA CHAR      SAVED BY UNPAK ROUTINE
      LDB PBUF      ADDRESS TO PACK INTO, - IF LOW BYTE 
      CLE 
      ELB,RBR       GET SIGN BIT
      SEZ,RSS       TEST IF SIGN BIT SET
      ALF,ALF       NO, SHIFT HIGH BYTE TO LOW BYTE 
      STA CHAR      SAVE CHARACTER
      LDA B,I       GET CONTENTS OF ASCII BUFFER
      SEZ 
      ALF,ALF 
      AND =B177     MASK HIGH BYTE
      SEZ 
      ALF,ALF 
      XOR CHAR      GET ACTUAL CHARACTER
      STA B,I       PACK INTO CURRENT PACK ADDRESS
      SEZ,CME       TEST IF SIGN BIT SET
      INB,RSS       INCREMENT PACK ADDRESS
      ELB,RBR 
      STB PBUF      SAVE NEW PACK BUFFER ADDRESS
      JMP PAK,I     RETURN
      SKP 
AT    OCT 100       ASCII "@" 
B377  OCT 377 
BLANK OCT 40
BLNKS OCT 20040 
COMMA OCT 54
DOT   OCT 56
SLASH OCT 57
STAR  OCT 52
LIMIT DEC -10       -NBR OF CHARS ALLOWED IN OUTPUT BUFFER
M2    DEC -2
M1    DEC -1
.2    DEC 2 
.6    DEC 6 
.8    DEC 8 
.10   DEC 10
.16   DEC 16
.41   DEC 41
.78   DEC 78
.126   DEC 126
ATCNT NOP           COUNT OF "@"'S FOUND
CHAR  NOP           CHAR UNPACKED BY UNPAK, PACKED BY PAK 
CNTWD NOP           ADDRESS OF 1ST WORD OF OUTPUT BUFFER
DOTCT NOP           COUNT OF ASCII DOTS FOUND (1 ALLOWED) 
ENDP  NOP           FLAG, -1 IF COMMA OR BUFFER END REACHED 
INCNT NOP           NBR OF REMAINING CHARS IN INPUT BUFFER
OUTCT NOP           NBR OF REMAINING CHARS IN OUTPUT BUFFER 
NONBL NOP           COUNT OF NON-BLANK CHARS FOUND BY SKIPC 
TEMP  NOP 
ALTRM NOP 
A     EQU 0 
B     EQU 1 
      END 
                                                                                                                                                        