ASMB,R,L,C
      HED "INAMR" RTE FMGR "NAMR" INVERSE PARSING ROUTINE 3-27-76 (DLB) 
*     NAM INAMR,7 PRE-REL 3-29-76 (DLB) 
      NAM INAMR,7 09570-16504 REV. A 761013 
* 
*-------------------------------------------------------- 
* 
*     RELOC.       09570-16504
*     SOURCE       09570-18504
* 
*     D. BASKINS         13 OCT 76 REV. A 
* 
*---------------------------------------------------------
* 
      ENT INAMR 
      EXT .ENTR 
      SPC 1 
A     EQU 0 
B     EQU 1 
*  THIS ROUTINE WILL DO A CAREFULL AND COMPLETE INVERSE PARSE OF A
*  BUFFER IN THE FORMAT THAT THE "NAMR" ROUTINE BUILDS IT.  THE STRING
*  GENERATED WILL BE VOID OF TRAILING SPACES, COLONS AND LEADING
*  ASCII ZERO'S.  THE STRING GENERATED WILL BE EQUAL OR SHORTER THAN
*  THE ORIGIONAL AND WILL PARSE USING THE "NAMR" ROUTINE BACK TO THE
*  ORIGIONAL TEN WORD BUFFER. 
      SPC 1 
*  THE TEN WORDS AS INPUT TO THIS ROUTINE 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
*  NOTE:  IF THE TYPE BITS ARE = 0 AND THE FIRST WORD IN THE PARAMETER
*         IS NOT = 0, THEN THE PARAMETER IS TAKEN TO BE ASCII AND 
*         THE SUB-PARAMETERS ARE TAKEN TO BE NUMERIC. 
*  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(INAMR(IPBUF,OTBUF,LENTH,NCHRS)) 10,20
* 
*      WHERE: 
*        IPBUF = TEN WORD INPUT PARAMETER BUFFER
*        OTBUF = STARTING ADDRESS OF BUFFER TO STORE OUTPUT STRING. 
*        LENTH = CHARACTER LENGTH OF "OTBUF". (MUST BE POSITIVE)
*        NCHRS = THE CURRENT NUMBER OF CHARACTORS IN "OTBUF".  THIS 
*                PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL 
*                TO "INAMR" AS THE CURRENT "TRANSMISSION LOG".
*        CAUTION!!!!
*        NCHRS  SHOULD START AS A ZERO IF NO CHARACTORS ARE IN "OTBUF". 
*        NCHRS  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 PASSED A BUFFER OF IN- 
*        SUFFICIENT LENGTH TO STORE STRING. (I.E. NCHRS => LENTH) 
*     20 BRANCH = THIS ROUTINE WAS PASSED A BUFFER WITH SUFFICIENT
*        LENGTH TO STORE INVERSE PARSED STRING. 
      SKP 
*      EXAMPLES THAT CAN BE INVERSED PARSED:
* 
*            STRING PASSED TO THE "NAMR" ROUTINE: 
*    +12345, DOUG:DB:-12B:,,GEORGE: A,  &PARSE:JB::4:-1:1775:123456B
* 
*            BUFFERS PRODUCED BY THE "NAMR" ROUTINE:
* 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
* 
*            STRING PRODUCED (INPARSED) FROM THE BUFFER:
*    12345,DOUG:DB:-10,,GEORGE:A,&PARSE:JB::4:-1:1775:-22738, 
* 
*         TEST PROGRAM
*FTN,L
*      PROGRAM TESTI
*      DIMENSION IB2(18),IB1(36),IPBUF(100) 
*      CALL RMPAR(IB1)
*      LU = IB1 
*      IF (LU.EQ.0) LU = 1
*    1 WRITE (LU,100) 
*  100 FORMAT ("INPUT ASCII NAMR'S TO PARSE ?") 
*      READ (LU,101) IB1
*  101 FORMAT (36A2)
*      CALL ITLOG(LEN)
*      IF (LEN.EQ.0) STOP 77
*      ISTRC = 1
*      NCHRS = 0
*  200 IFLG1 =  NAMR(IPBUF,IB1,LEN,ISTRC) 
*      IF (IFLG1.LT.0) WRITE (LU,206) 
*  206 FORMAT ("NAMR OUT OF DATA")
*      IFLG2 = INAMR(IPBUF,IB2,36,NCHRS)
*      IF (IFLG2.LT.0) WRITE (LU,207) 
*  207 FORMAT ("INAMR OUT OF BUFFER") 
*      IF(IFLG1.LT.0.OR.IFLG2.LT.0) GO TO 1 
*      CALL EXEC (2,LU,IB2,-NCHRS)
*      GO TO 200
*      END
*      END$ 
      SKP 
*  CHECK CALLERS PARAMETERS FOR CORRECTNESS 
      SPC 1 
IPBUF NOP           TEN WORD INPUT BUFFER 
OTBUF NOP           OUTPUT BUFFER ADDRESS 
LENTH NOP           LENGTH OF OUTPUT BUFFER IN CHARACTERS 
NCHRS NOP           CURRENT STARTING CHARACTER IN OTBUF 
INAMR NOP           ENTRY POINT 
      JSB .ENTR     GET PARAMS ADDRESS
      DEF IPBUF 
      LDA OTBUF     FORM STARTING CHARACTER 
      CLE,ELA       ADDRESS OF OUTPUT BUFFER
      STA OTBUF     SAVE AS CHARACTER ADDRESS.
      LDB LENTH,I   GET CHARACTER LENGTH
      ADA B         CHECK IF IN CORE BOUNDS 
      LDA NCHRS,I   GET START CHAR-1 IN "OTBUF" 
      STA SAVST     SAVE START CHARACTOR NUMBER 
      CMB,SSB,INB,SZB CHECK FOR 0 & NEG.
      SSA           CHECK NCHRS FOR ZERO OR POSITIVE
ERREX CCE           FORCE ERROR EXIT
      ADB A         NCHRS MUST BE < LENTH 
      CCA,SEZ       TEST E FOR ERROR
      JMP INAMR,I    RETURN A= -1 FOR ERROR 
      CLA           INITITIALIZE
      STA SPACT     TRAILING SPACE COUNT
      STA COLCT     TRAILING COLON COUNT
      LDA IPBUF     GET INPUT BUFFER ADDRESS
      LDB D3        GET LENGTH OF BUFFER (WORDS)
      ADB A         GET ADDRESS OF PARAMETER TYPE 
      STB IPBUF     SAVE ADDRESS OF WORD4 
      LDB B,I       GET PARAMETER TYPE WORD 
      STB WORD4     SAVE FOR FUTURE EXAMINATION 
      LDB D3        GET LENGTH OF PARAMETER 
      JSB SCAN      GET 1ST PARAMETER 
      LDB DM6       NOW SCAN FOR NEXT 5 SUB-PARAMS
      STB SUBCT 
MORE1 ISZ IPBUF     BUMP TO NEXT PARAMETER
      LDA WORD4     NOW POSITION PARAMETER TYPE 
      RAR,RAR       BITS FOR NEXT PARAMETER 
      STA WORD4 
      LDA IPBUF     GET DESTINATION BUFFER ADDRESS
      CLB,INB       AND THE LENGTH
      JSB SCAN      GET NEXT SUB PARAM
      ISZ SUBCT     DONE WITH ALL SIX?
      JMP MORE1     NO, CONTINUE
      LDB LENTH,I   CHECK IF AT END OF BUFFER BEFORE STORING
      CPB NCHRS,I   THE COMMA IN THE BUFFER 
      JMP *+3       SKIP COMMA STORE AND START CHARACTOR STORE
      LDA COMMA 
      JSB PUTCR     PUT COMMA IN BUFFER 
      CLA,CLE       RETURN A-REG = 0
      JMP INAMR,I   RETURN DONE 
      SPC 1 
SCAN  NOP           A=DEST BUFFER ADDRS, B=LENGTH(WORDS)
      STA DESTA     SAVE DESTINATION ADDRESS
      CMB,INB       MAKE NEG. 
      STB DESTL     SAVE DEST. BUFFER LENGTH (WORDS)
      LDA WORD4     GET PARAMETER TYPE
      AND D3        GET TYPE BITS 
      CPA D3        IF = 3 THEN ASCII 
      JMP ASCII 
      SLA           IF = 1 THEN NUMBERIC
      JMP NUMBR 
      IOR DESTA,I   MUST BE 0 OR 2, CHECK IF PARM IS NULL 
      SZA,RSS       NULL? 
      JMP STOCL     YES, GO STORE COLON 
      INB,SZB       CHECK IF LENGTH = 1 WORD
      JMP ASCII     OR ASCII IF MORE THAN 1 WORD. 
      SPC 1 
NUMBR LDA O60       GET AN ASCII 0 IN CASE NUMB. IS = 0 
      STA LDFLG     SET THE LEADING 0 SUPPRESS FLAG 
      LDB DESTA,I   GET NUMBER
      CMB,CCE,SSB,INB,SZB CHECK IF NUMBER IS 0 OR - 
      CMB,CLE,INB   POSITIVE, CLE 
      STB CURVL     SAVE ABS VALUE OF NUMBER
      SEZ,SZB       IF + OR 0 SKIP
      LDA MINUS     IF NEG STORE "-" IN BUFFER
      CLB,SEZ       IF POSITIVE SKIP STORE IF - OR 0
      JSB PUTCR     STORE A "0" OR "-"
      LDA D10K      INITIALIZE THE POWER WORD 
MORNM STA POWER 
      LDA CURVL     GET CURRENT VALUE OF NUMB.
      DIV POWER     FROM NUMBER 
      STB CURVL     AND SAVE THE REMAINDER
      ADA O60       CONVERT TO ASCII NUMBER 
      CPA LDFLG     CHECK IF LEADING ZERO?
      JMP *+3       YES, SKIP STORE 
      JSB PUTCR     AND PUT IN STRING BUFFER
      STB LDFLG     CLEAR LEADING ZERO SUPPRESS FLAG
      LDA POWER     NOW DIVIDE THE POWER BY 10
      CLB           IN CASE OF LEADING ZERO 
      DIV D10 
      SZA           CHECK IF POWER IS = ZERO? 
      JMP MORNM     NO, MORE DIGITS TO CONVERT
STOCL LDA COLON     GET THE : 
      JSB PUTCR     AND PUT IN BUFFER 
      JMP SCAN,I    RETURN TO CALLER
      SPC 1 
ASCII LDA DESTA,I   MOVE ASCII BUFFER INTO OUTPUT STRING
      ALF,ALF       POSITION AND ASSUME LEFT JUSTIFIED
      JSB PUTCR     AND PUT IN DEST BUFFER
      LDA DESTA,I   GET 2ND CHAR
      JSB PUTCR 
      ISZ DESTA     BUMP TO NEXT WORD 
      ISZ DESTL     CHECK IF DONE?
      JMP ASCII     NO, MOVE MORE WORDS 
      JMP STOCL     STORE : AND EXIT
      SPC 1 
PUTCR NOP           STORE CHAR IN CALLERS BUFFER
      AND O177      MASK TO ONE CHAR
      STA SAVCR     SAVE THE CHARACTOR
      CPA COLON     CHECK IF CHAR IS ":"
      CLB,RSS       ZERO SPACE COUNT AND BUMP : COUNT 
      JMP *+4 
      STB SPACT     ZERO SPACE COUNT
      ISZ COLCT     BUMP COLON COUNTER
      JMP PUTEX     RETURN
      CPA O40       CHECK IF CHAR IS ASCII SPACE
      CLB,RSS       YES, BUMP THE SPACE COUNT 
      JMP *+3 
      ISZ SPACT     BUMP THE SPACE COUNT
      JMP PUTEX     AND RETURN
      CPA COMMA     CHECK IF CHAR IS COMMA? 
      CLB,RSS       YES, ZERO COLON & SPACE COUNT 
      JMP *+3       SKIP ZERO SPACE & : 
      STB COLCT     ZERO COLON COUNT
      STB SPACT     ZERO SPACE COUNT
      LDB COLCT     GET CURRENT COLON COUNTER 
      CMB,INB,SZB,RSS 
      JMP NOCOL     NO COLONS, LOOK FOR SPACES
      STB COLCT     SAVE COUNTER
      LDA COLON     NOW STORE COLONS UNTIL COUNT EXAUSTED 
      JSB STOCR     GO STORE THE COLONS 
      ISZ COLCT     DONE? 
      JMP *-3       NO, DO ANOTHER
NOCOL LDB SPACT     GET THE SPACE COUNT 
      CMB,INB,SZB,RSS CHECK IF ANY SPACES?
      JMP STORE     NO SPACES, GO STORE CHARACTOR 
      STB SPACT     SAVE SPACE COUNT
      LDA O40       GET AN ASCII SPACE
      JSB STOCR     STORE IN LEADING OR IMBEDDED SPACES 
      ISZ SPACT     DONE? 
      JMP *-3       NO GO STORE ANOTHER ONE 
STORE LDA SAVCR     RETRIVE THE ORIGIONAL STORE CHAR
      JSB STOCR     GO STORE IT.
PUTEX CLB 
      JMP PUTCR,I   RETURN B-REG = 0
      SPC 1 
STOCR NOP           STORE CHARACTOR IN A-REG IN CALLERS BUFFER
      LDB NCHRS,I   GET NUMB CHARS IN BUFFER
      CPB LENTH,I   IF EQUAL TO BUFFER LENGTH>NO MORE STORE 
      JMP ENDBF     YES, ERROR
      ADB OTBUF     NO, CALCULATE CHARACTOR BUFFER ADDRESS
      ISZ NCHRS,I   BUMP THE NUMBER OF CHARS COUNTER
      CLE,ERB       CHANGE TO WORD ADDRESS
      SEZ,RSS       CHECK EVEN/ODD FLAG 
      ALF,SLA,ALF   AND POSITION
      XOR B,I       MERGE IN WITH OLD WORD
      XOR O40       AND PUT IN/TAKE OUT SPACE 
      STA B,I       AND PUT BACK IN BUFFER
      JMP STOCR,I   AND RETURN P+1
      SPC 1 
ENDBF LDA SAVST     RESTORE THE START CHARACTOR 
      STA NCHRS,I   POINTER 
      JMP ERREX     AND RETURN ERROR EXIT 
      SPC 1 
SPACT NOP           NUMBER OF TRAILING SPACES 
COLCT NOP           NUMBER OF TRAILING COLONS 
SAVST NOP           START CHARACTOR SAVE LOCATION 
SAVCR NOP           SAVED STORE CHARACTOR 
LDFLG NOP           LEADING ZERO SUPPRESS FLAG
POWER NOP           WORKING WORD
CURVL NOP           WORKING WORD
DESTA NOP           DESTINATION BUFFER ADDRESS
DESTL NOP           DEST. BUFFER LENGTH IN CHARACTERS 
      SPC 1 
O177  OCT 177 
MINUS OCT 55
O60   OCT 60
O40   OCT 40
COMMA OCT 54
COLON OCT 72
D3    DEC 3 
D10   DEC 10
D10K  DEC 10000 
DM6   DEC -6
SUBCT NOP           HOLDS SUB-PARAM. COUNTER
WORD4 NOP           HOLDS VALUE OF IPBUF(4) 
      END 
                                                                                                                                                                                                                                    