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