ASMB,R,L,C
      HED "NAMR" RTE FMGR "NAMR" PARSING ROUTINE 2-9-75 (DLB) 
* 
*     NAME:   NAMR
*     SOURCE: 92068-18021 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   R.A.G.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 NAMR,7 92068-1X021 REV.2013 750701
      ENT NAMR
      EXT .ENTR 
      SPC 1 
*  TIRED OF TRYING TO PARSE A "NAMR" IN FORTRAN OR ASSEMBLY ??????????
      SPC 1 
*  THIS ROUTINE WILL DO A CAREFULL AND COMPLETE PARSE OF A BUFFER 
*  JUST LIKE THE RTE-II FILE MANAGER "FMGR" ROUTINE WILL.  IT WAS 
*  WRITTEN TO BEHAVE EXACTLY LIKE THE "FMGR" DOES.  I WISH THE PEOPLE 
*  THAT WROTE SXL, SCEGN, AND DISTRIBUTED SYSTEMS WOULD GET THE IDEA. 
*  ALSO, IT WOULDN'T BE VERY HARD TO ALLOW SPACES ALONG WITH
*  COMMAS TO BE DELIMITERS OF "NAMR'S". (I.E. HP 3000 & FTN4) 
*  THIS ROUTINE WILL READ AN INPUT BUFFER OF ANY LENGTH AND PRODUCE 
*  A PARAMETER BUFFER 10 WORDS LONG.
      SPC 1 
*  THE TEN WORDS ARE DESCRIBED AS FOLLOWS:
      SPC 1 
*  WORD 1 = 0 IF TYPE = 0 (SEE BELOW) 
*  WORD 1 = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1
*  WORD 1 = CHARS 1 & 2 IF TYPE = 3 
*  WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3.
*  WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) 
*  WORD 4 = PARAMETER TYPE OF ALL 7 PARAMETERS IN 2 BIT PAIRS.
*           0 = NULL PARAMETER
*           1 = INTEGER NUMERIC PARAMETER 
*           2 = NOT IMPLEMENTED YET. (FMGR?)
*           3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. 
*           BITS FOR ,FNAME : P1  : P2  : P3  : P4  : P5   : P6 , 
*                      0,1   2,3   4,5   6,7   8,9  10,11  12,13
*  WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1.
*  WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. 
*  WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS)
*  WORD 8 = 4TH    "
*  WORD 9 = 5TH    "
*  WORD 10 = 6TH SUB-PARAM. (FOR POSSIBLE FUTURES I.E. SYSTEM #)
      SKP 
*      CALLED:
*       IF( NAMR (IPBUF,INBUF,LENTH,ISTRC)) 10,20 
* 
*      WHERE: 
*        IPBUF = TEN WORD DESTINATION PARAMETER BUFFER
*        INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". 
*        LENTH = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE)
*        ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF".  THIS
*                PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL 
*                TO "NAMR" AS THE START CHARACTER IN "INBUF". 
*        CAUTION!!!!
*        ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST 
*        BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER.(FTN) 
* 
*     10 BRANCH = A-REG RETURNS NEG IF NOT PASSED A BUFFER OF 
*        GREATER THAN ZERO LENGTH TO PARSE. (I.E. LENTH < ISTRC)
*     20 BRANCH = THIS ROUTINE WAS PASSED A BUFFER OF AT LEAST ONE
*        CHARACTER IN LENGTH. (MAY BE A ASCII SPACE, BUT IT IS THERE) 
      SKP 
*      EXAMPLES THAT CAN BE PARSED: 
* 
*    +12345, DOUG:DB:-12B:,,GEORGE: A,  &PARSE:JB::4:-1:1775:123456B
* 
*      WHERE: 
* 
* NAMR #  W1    W2    W3    W4    W5    W6    W7    W8    W9    W10 
* 
*   1   12345   0     0   00001B  0     0     0     0     0 
*   2     DO    UG        00037B  DB   -10    0     0     0     0 
*   3     0     0     0   00000B  0     0     0     0     0     0 
*   4     GE    OR    GE  00017B  A     0     0     0     0     0 
*   5     &P    AR    SE  12517B  JB    0     4    -1   1775  -22738
* 
*         TEST PROGRAM
*FTN,L
*      PROGRAM TESTN
*      DIMENSION IB(36),IDMY(2),IPBUF(10) 
*      EQUIVALENCE (IDMY,DMY),(LEN,IDMY(2)) 
*    1 WRITE (1,100)
*  100 FORMAT ("INPUT ASCII NAMR'S TO PARSE ?") 
*      DMY = EXEC (1,401B,IB,-72) 
*      ISCR = 1 
*      DO 200 I=1,10
*      IF ( NAMR(IPBUF,IB,LEN,ISCR)) 1,210
*  210 WRITE (1,220) ISCR,IPBUF,IPBUF 
*  220 FORMAT (" "/,I3,10(X,I6)/" "3A2,7(X,O6)) 
*  200 CONTINUE 
*      STOP 
*      END
*      END$ 
      SKP 
*  CHECK CALLERS PARAMETERS FOR CORRECTNESS 
      SPC 1 
IPBUF NOP           TEN WORD DEST BUFFER*NMPMS) 
INBUF NOP           INPUT BUFFER ADDRESS
LENTH NOP           TRANSMISSION LOG IN CHARACTERS
ISTRC NOP           CURRENT STARTING CHARACTER IN INBUF 
NAMR  NOP 
      JSB .ENTR     GET PARAMS ADDRESS
DPBUF DEF IPBUF 
      LDB IPBUF     NOW CLEAR OUT DEST BUFFER 
      LDA D10       GET DEST BUFFER LENGTH
      CMA,INA       MAKE NEG. 
      STA SUBCT     SAVE IN TEMP
      CLA           ZERO BUFFER 
      STA B,I 
      INB 
      ISZ SUBCT 
      JMP *-3 
      LDA INBUF     FORM STARTING CHARACTER 
      CLE,ELA       ADDRESS OF INPUT
      STA INBUF     SAVE AS CHARACTER ADDRESS.
      LDB LENTH,I   GET CHARACTER LENGTH
      ADA B         GET ADDRESS OF LAST+1 CHARACTER 
      STA EOFBF     AND SAVE FOR LATER USE
      LDA ISTRC,I   GET START CHAR IN "INBUF" 
      CMB,SSB,INB,SZB CHECK FOR 0 & NEG.
      CMA,INA,RSS   >0, MAKE ISTRC NEG. + TEST FOR 0
      CCE           DIDN'T PASS, SET FLAG 
      CMA           SUBTRACT 1 FROM ISTRC 
      ADB A          A-REG = ISTRC - LENTH -1 
      CCA,SEZ       TEST E FOR ERROR
      JMP NAMR,I    RETURN A= -1 FOR ERROR
      LDA IPBUF     GET DESTINATION BUFFER
      LDB D3        GET LENGTH OF BUFFER (WORDS)
      JSB SCAN      GET 1ST PARAMETER 
      LDB IPBUF     GET DEST. PARAM. ADDRESS
      ADB D3        BUMP TO WORD 4
      STB IPBUF     SAVE AS BUFFER POINTER
      STB WORD4     SAVE AS PARAM. TYPE POINTER 
      RAR,RAR       POSITION "TYPE BITS"
      STA B,I       AND INITIALIZE
      LDB DM6       NOW SCAN FOR NEXT 5 SUB-PARAMS
      STB SUBCT 
MORE1 ISZ IPBUF 
      LDA IPBUF     GET DESTINATION BUFFER ADDRESS
      CLB,INB       AND THE LENGTH
      JSB SCAN      GET NEXT SUB PARAM
      IOR WORD4,I   MIRGE IN WITH PREV. 
      RAR,RAR       POSITION "PARAM TYPE BITS"
      STA WORD4,I   AND PUT BACK
      ISZ SUBCT     DONE WITH ALL SIX?
      JMP MORE1     NO, CONTINUE
      RAR,RAR       PUT IN CORRECT POSITION 
      STA WORD4,I   FOR !!!SIX!!! SUB-PARAMETERS
MORE2 CLB,INB       NOW SCAN UNTIL "," OR EOB.
      LDA DPBUF     GET DUMMY BUFFER ADDRESS
      JSB SCAN      DATA WILL BE STORED LOCALLY 
      CPB EOFBF     CALL SCAN UNTIL "," OR EOB. 
      JMP NAMR,I    REACHED COMMA OR END OF BUFFER
      JMP MORE2     DUMGUY, MORE COLONS 
      SKP 
*  SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS 
* 
* 
*   SOB    ,       -      1 2 3 4      B      ,      EOB
*    ^      ^      ^      ^      ^      ^      ^      ^ 
*  INBFF  ISTAR  FSTCA  FNMCA  LNBCA  LSTCA  EOFBF  INBFF+LENTH 
      SPC 1 
*   WHERE:
*     INBFF = START OF BUFFER (CHARACTER ADDRESS) 
*     ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF".
*     FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. 
*     FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". 
*     LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. 
*     EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. 
*     INBFF+LENTH = END OF BUFFER + 1 CHARACTER ADDRESS.
      SPC 1 
EOFBF EQU LENTH     ADDRS. OF LAST CHAR+1,IN "INBFF"
INBFF EQU INBUF     ADDRS. OF "INPUT BUFFER TO SCAN"
ISTAR EQU ISTRC     ADDRS. OF START CHAR IN "INBFF" 
      SPC 1 
SCAN  NOP           A=DEST BUFFER ADDRS, B=LENGTH(WORDS)
      STA DESTA     SAVE DESTINATION ADDRESS
      STB DESTL     SAVE DEST. BUFFER LENGTH (WORDS)
*-    ADB A         FORM LAST+1 ADDRESS 
*-    STB FSTCA     SAVE TEMP 
*-    CLB           ZERO OUT THE DESTINATION BUFFER 
*-ZMORE STB A,I 
*-    INA 
*-    CPA FSTCA     DONE? 
*-    CCB,RSS       YES, CONTINUE 
*-    JMP ZMORE     NO, ZERO SOME MORE
      SPC 1 
*  SCAN UNTIL NON ASCII SPACE & SET "FSTCA" 
      SPC 1 
      CCB           GET MINUS ONE IN B-REG. 
      ADB INBFF     ADDRESS OF THE START
      ADB ISTAR,I   CHARACTER 
AMORE STB FSTCA     SAVE THE 1ST CHAR ADDRESS 
      STB LSTCA     AND LAST CHAR ADDRESS 
      STB LNBCA     SET LAST NON "B" CHAR. ADDRS. 
      STB FNMCA     SET 1ST NON "-" OR "+" CHAR ADDRS.
      CLA           EXIT, A-REG = PARAMETER TYPE
      CPB EOFBF     CHECK IF END OF BUFFER
      JMP SCAN,I    NULL PARAMETER  RETURN
      JSB GNC       GET NEXT CHARACTER
      ISZ ISTAR,I   ADVANCE CHARACTER POINTER 
      CPA O40       IS IT EQUAL TO ASCII SPACE
      JMP AMORE     YES, IGNORE IT
      STA FSTCR     SET THE FIRST CHARACTER 
      CPA PLUS      CHECK IF 1ST CHAR 
      RSS           IS A PLUS OR MINUS
      CPA MINUS     IF IT IS, BUMP
      ISZ FNMCA     THE START CHAR FOR NUMB. CONV.
      SPC 1 
*   SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER.
      SKP 
SMORE CPA COLON     COLON DELIMETER 
      JMP CONVT     NOW, GO CONVERT POSSIBLE #
      CPA COMMA     CHECK IF COMMA
      JMP TERMC     AND DUMMY UP END OF BUFFER
      CPA "B"       CHECK THE TRAILING CHARACTER
      CCE,RSS       FOR A "B". IF IT IS,
      STB LNBCA     DON'T SET THE NON B CHAR ADDRS. 
      LDA D10       SET THE BASE = 10 
      SEZ           CHANGE TO B= 8, IF LAST CHAR
      LDA O10       IS EQUAL TO "B" 
      STA BASE1     SET BASE OF NUMBER SYSTEM 
      ADA O60       AND CALCULATE UPPER 
      CMA,INA       LIMIT CHECK WORD. 
      STA BASE2     AND FOR LATER USE 
      STB LSTCA     AND IT'S ADDRESS+1
SIGNR CPB EOFBF     REACHED END OF INBFF? 
      JMP CONVT     YES, SKIP NEXT CHAR 
      JSB GNC       GET NEXT CHARACTER
      ISZ ISTAR,I   ADVANCE THE CHARACTER POINTER 
      CPA O40       IGNORE TRAILING SPACES
      JMP SIGNR     BY NOT ENCLUDING IN SCAN
      JMP SMORE     GO CHECK IT 
      SPC 1 
TERMC STB EOFBF      IGNORE FUTHER CALLS TO SCAN
      SPC 1 
*  CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT.
      SPC 1 
CONVT CLA           NOW TRY NUMBER CONVERSION 
      LDB FSTCA     GET 1ST CHAR ADDRESS
      CPB LSTCA     IS IT = LAST CHAR ADDRESS?
      JMP SCAN,I    YES, RETURN, NULL PARAMETER 
      LDB FNMCA     CHECK IF ANY DATA TO BE 
      CPB LNBCA     CONVERTED TO A
      JMP NOTNU     NUMBER. 
      SPC 1 
*  NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER
*     NOTE: 
*   THE REV B RTE-II FMGR DOES NOT ACCOUNT FOR NUMBER OVERFLOWS.
*   THE LINES OF CODE MARKED WITH "*" MAY BE DELETED IF YOU 
*   WANT THIS CODE TO ACCOUNT FOR NUMBER OVERFLOWS. (DLB) 
      SPC 1 
MMORE MPY BASE1      TRY CONVERSION 
*     SSA,RSS       * CHECK IF OVERFLOWED?
*     SZB           * CHECK IF OVERFLOWED?
*     STO           * YES, SET FLAG FOR LATER USE 
      STA DESTA,I   ACCUMULATE NUMBER 
      LDB FNMCA     GET CURRENT CHAR ADDRESS
SKIP1 JSB GNC       GET THE NEXT CHARACTER
      STB FNMCA     PUT BACK + 1
      CPA O40       IGNORE ASCII SPACES 
      JMP SKIP1 
      ADA BASE2     NO, CHECK IF ASCII NUMBER 
      SEZ,CLE,RSS   NUMBER MUST BE "0" TO "BASE"
      ADA BASE1 
      SEZ,CLE,RSS 
      JMP NOTNU     NOT NUMBER, MOVE BUFFER 
      ADA DESTA,I   ACCUMULATE THE NUMBER 
*     SOC           * CHECK OF OVERFLOWED?
*     CCA           * YES, FORCE RESULT NEG.
      CPB LNBCA     DONE? 
      RSS           YES, CONTINUE 
      JMP MMORE 
      SPC 1 
*  NOW CHECK SIGN OF NUMBER 
      SPC 1 
*     SOC           * TEST IF OVERFLOW? 
*     RAL,CLE,ERA   * CHANGE -1 TO 77777B IF OVERFLOW 
      LDB FSTCR     CHECK SIGN OF NUMBER
      CPB MINUS     WAS IT NEG? 
*     CMA,SEZ       * YES. (*CHANGE TO CMA,INA) 
      CMA,INA       YES, MAKE NEG.
*     RSS           * 
*     INA           * 
      STA DESTA,I   SAVE BACK IN DEST. BUFFER 
      CLA,INA,RSS   EXIT A=1 FOR PARAMETER TYPE 
EXIT3 LDA D3        EXIT A=3 FOR PARAMETER TYPE 
      JMP SCAN,I    RETURN DONE 
      SPC 1 
*  NOT NUMBER, MOVE PARAM INTO DEST. BUFFER 
      SPC 1 
NOTNU LDB DESTA     GET DEST BUFFER ADDRS 
      CLE,ELB       FORM CHARACTER ADDRESS
      STB FNMCA     SAVE FOR NEAR USE 
      ADB DESTL     FORM LAST CHAR+1 ADDRESS
      ADB DESTL     TIMES 2 FROM WORDS
      STB LNBCA     SAVE FOR NEAR USE 
MSTOR LDB FSTCA     GET FIRST CHAR. ADDRESS 
      LDA O40       GET SPACE JUST IN CASE
      CPB LSTCA     CHECK IF LAST CHARACTER ADDRESS 
      JMP SKIP2     YES, SKIP GET CHAR FROM "INBFF" 
      JSB GNC       GET NEXT CHARACTER
      STB FSTCA     SAVE NEXT CHAR ADDRESS
SKIP2 LDB FNMCA     GET DEST CHAR ADDRESS 
      CPB LNBCA     CHECK IF END OF DEST. BUFFER
      JMP EXIT3     YES, RETURN DONE
      ISZ FNMCA     BUMP TO NEXT CHAR 
      CLE,ERB       CHANGE TO WORD ADDRESS
      SEZ,RSS       POSITION
      ALF,SLA,ALF   PACK
      XOR B,I       AND 
      XOR O40       STORE 
      STA B,I       BACK
      JMP MSTOR     GO TRY NEXT CHAR
      SPC 1 
FSTCR NOP           FIRST NON SPACE CHARACTER IN BUFFER 
FSTCA NOP           ADDRESS OF FSTCR
LSTCA NOP           ADDRESS OF LSTCR
BASE1 NOP           BASE OF NUMBER
BASE2 NOP           HI BASE TEST OF NUMBER
FNMCA NOP           CURRENT CHAR SCAN FOR CONVT 
LNBCA NOP 
DESTA NOP           DESTINATION BUFFER ADDRESS
DESTL NOP           DEST. BUFFER LENGTH IN CHARACTERS 
      SPC 1 
GNC   NOP           GET NEXT CHARACTER
      CLE,ERB       FORM WORD ADDRESS DESTROY E-REG 
      LDA B,I       GET WORD
      SEZ,RSS       HI -OR- LO CHARACTER
      ALF,ALF 
      AND O177      MASK DOWN TO 7 BITS 
      ELB           RESTORE B-REG 
      INB           BUMP THE B-REGISTER 
      JMP GNC,I     RETURN A= CHARACTER 
      SPC 1 
O177  OCT 177 
"B"   OCT 102 
MINUS OCT 55
PLUS  OCT 53
O60   OCT 60
O40   OCT 40
COMMA OCT 54
COLON OCT 72
D3    DEC 3 
O10   OCT 10
D10   DEC 10
DM6   DEC -6
SUBCT NOP           HOLDS SUB-PARAM. COUNTER
WORD4 NOP           HOLDS ADDRESS OF IPBUF(4) 
A     EQU 0 
B     EQU 1 
      END 
* 
* 
                                                                                                                                                      