SPL,L,O,M 
!     NAME:   .PARS 
!     SOURCE: 92070-18011 
!     RELOC:  92070-16011 
!     PGMR:   G.A.A.,A.M.G
! 
!  ***************************************************************
!  * (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.       *
!  ***************************************************************
! 
      NAME .PARS (8) "  92070-1X011  REV.2001  800103"
! 
!     THE PARSE SUBROUTINE AND ITS ROUTINES SCAN AN ASCII 
!     STRING AND PRODUCES:
! 
!        A.  AN ACTION ROUTINE ADDRESS (CAD.) 
!        B.  A PARAMETER COUNT  (NOCM.) 
!        C.  A PARAMETER LIST WITH 4 WORDS FOR EACH PARAMETER: (P.RAM)
! 
!               1.  TYPE
!                   (A.)  0 - NULL
!                   (B.)  1 - NUMBER
!                   (C.)  1 - SIGNED OR OCTAL NUMBER
!                   (D.)  3 - ASC STRING
! 
!               2.  FOR TYPE 1 THE VALUE, 
!                   ELSE FOR TYPE 3 THE FIRST TWO CHARACTERS. 
! 
!               3.  FOR TYPE 3 CHARACTERS 3 AND 4.
! 
!               4.  FOR TYPE 3 CHARACTERS 5 AND 6.
! 
!        D.  A 10 WORD OPTION LIST AT N.OPL 
!               OPTIONS MAY APPEAR ON THE FIRST TWO PARAMETERS
!               OPTIONS ARE SEPERATED FROM EACH OTHER AND FROM
!               THE PARAMETER ITSELF BY COLONS. 
!               EACH OPTION IS STORED IN N.OPL STARTING AT
!               WORD ZERO FOR PARAMETER ONE AND WORD 5 FOR PARAMETER TWO
!               THERE MAY BE ONLY FIVE OPTIONS PER PARAMETER. 
!               THE FIRST TWO PARAMETERS MAY BE ASCII,THE REST
!               MUST BE NUMERIC.
!     THE INPUT STRING IS TO BE DELIMITED BY COMMAS.
!     BLANKS ARE IGNORED UNLESS THEY ARE WITHIN ASCII STRINGS.
!     THE FIRST CHARACTER MUST BE ":" IF INPUT IS NOT FROM A TTY. 
! 
! 
! 
      LET INT.,    \INTERACTIVE INPUT FLAG
          U.CMD,   \USER'S COMMAND
          N.OPL,   \NAMER SUBPARAMETER LIST 
          SVCOD,   \FMGR INTERNAL SEVERITY CODE 
          P.RAM,   \PARAMETER LIST ARRAY
          P.CNT,   \NUMBER OF PARAMETERS FOUND
          G0..,    \GLOBAL ARRAY
          CAD.,    \COMMAND ADDRESS OR INDEX IF IN SEGMENT
          ECH,     \INPUT COMMAND LENGTH(WORDS) RESET FOR ECHO
          C.DLM,   \CHARACTER ADDRESS OF FIRST DELIMITER AFTER COMMAND
          C.TAB,   \COMMAND TABLE (SIGN SET ON COMMAND INDICATES SPECIAL) 
          CUSE.,   \CURRENT SEGMENT SUFFIX CHARACTER
          C.BUF,   \COMMAND BUFFER
          O.BUF,   \OUTPUT DCB, USED AS A WORKING BUFFER
          SCR.     \CHARACTERS 3 AND 4 OF COMMAND (OR 0 IF NONE)
                 BE INTEGER,EXTERNAL
      LET FM.ER,   \PRINT ERROR MESSAGE ROUTINE 
          ECHO,    \ECHO THE COMMAND ROUTINE
          CNUMD,   \NUMBER TO ASCII CONVERSION ROUTINE
          MSS.,    \ERROR MESSAGE ROUTINE 
          MVW      \FMGR MOVE WORDS SUBROUTINE
                 BE SUBROUTINE,EXTERNAL 
      LET IN.ER BE SUBROUTINE 
      LET COLON BE CONSTANT(72K )                ! :
      LET BLANK BE CONSTANT(40K ) 
      LET COMMA BE CONSTANT (54K )               ! ,
      LET CHAR0 BE CONSTANT(60K )                ! 0
      LET PSIGN BE CONSTANT(53K)                 ! +
      LET MSIGN BE CONSTANT(55K)                 ! -
      LET QUES  BE CONSTANT(   77K)              ! ?
! 
! 
! 
GETCR: FUNCTION DIRECT
      .B._PTR                               !CHARACTER ADDRESS TO B.
      ASSEMBLE["CLE,ERB";                   \CORE ADDRESS TO B,E=U/L 0/1
               "LDA 1,I";                   \GET THE WORD 
               "ELB";                       \ADDRESS BACK TO B
               "SLB,INB,RSS";               \STEP THE ADDRESS SKIP IF LOW CHAR
               "ALF,ALF"  ]                 !ROTATE TO LOW IF NEEDED
      PTR_.B.                               !RESTORE B TO POINTER 
      .A.,CHAR_.A. AND 377K                 !ISOLATE THE CHARACTER AND SAVE 
      RETURN .A.                            !DONE GET OUT 
       END
! 
PUTCR: FUNCTION DIRECT
      IF [.B._BUFPT]=LIMIT THEN GO TO EXITF !EXIT IF NO ROOM
      .A._CHAR                              !CHAR TO A FOR ASSMBLY
      ASSEMBLE["CLE,ERB";                   \WORD ADD TO B, U/L FLAG TO E 
               "XOR 1,I";                   \KEEP OLD HIGH CHAR 
               "AND LOWM";                  \IN CASE THIS IS LOW
               "XOR 1,I";                   \NEW CHAR IN LOW A  OLD IN HIGH 
               "SEZ,RSS";                   \IF UPPER 
               "ALF,ALF";                   \ROTATE 
               "STA 1,I";                   \STASH IT AWAY
               "ISZ BUFPT" ]                !PUSH BUFFER POINTER BACK TO SPL
      IF CHAR=BLANK THEN[                   \IF FIRST BLANK AFTER 
         IFNOT BF THEN BUFPT_BUFPT-1;       \BF SET TO ZERO 
         RETURN 1],                         \RETURN TRUE FOR ALL BLANKS 
      ELSE [                                \NOT A BLANK
         BF,BFEND_BUFPT;                    \KEEP TRACK OF HIGHEST NON BLANK
         RETURN 0                           \AND RETURN ZERO
      ] 
      END 
! 
GETCR.EQ.DELIM:FUNCTION DIRECT                   !RETURNS TRUE IF NEXT
                                                 !CHARACTER IS DELIMETER, 
                                                 !FALSE IF NOT
! 
      IF PTR=EOL THEN[                      \IF END OF LINE 
         STOPF,CHAR_1;                      \SET STOP FLAG AND
         GO TO DELT                         \EXIT TRUE
       ]
      IF GETCR=COLON THEN GO TO DELT        !ELSE GET CHAR AND
      IF CHAR =COMMA THEN GO TO DELT        !IF ":" OR "," EXIT TRUE
      RETURN 0                              !EXIT FALSE NOT A DELIMITER 
! 
DELT: RETURN 1                              !EXIT TRUE A DELIMITER
      END 
! 
DIGT:  FUNCTION DIRECT
      IF [CRAC_CHAR-CHAR0] >= 0 THEN[       \IF GREATER THAN "0"
         IF CRAC < BASE THEN [              \AND LESS THAN BASE ACCUMULATE
            VAL_VAL*BASE+CRAC;              \T NUMBER SET THE FLAG AND
            T_1;                            \ 
            RETURN T                        \RETURN TRUE
         ]  \ 
      ] 
      RETURN 0                              !ELSE RETURN FALSE
       END
! 
!  PARSE ROUTINE BEGINS HERE. 
! 
.PARS:SUBROUTINE GLOBAL,FEXIT 
! 
!  THE FOLLOWING IS PASS 1 OF A 2-PASS PARSE.  THE PROMPT 
!  CHARACTER, IF PRESENT, IS REMOVED, GLOBALS ARE TRANSLATED AND
!  BLANKS BEFORE AND AFTER DELIMITERS ARE REMOVED.
! 
      BASE_10 
      LOWM_377K                             !ESTABLISH CONSTANT FOR PUTCH 
       ACM,STOPF _ 0                        !ZERO EOL FLAG AND COMMAND FLAG 
       EF,PTR,CBUFC _[CBUFA_@C.BUF]-<1      !SET CHARACTER ADDRESSES
       EOL_CBUFC+ECH+ECH                    !END OF LINE FLAG (CHAR ADRS) 
       BUFPT,CRONE_[C.DLM_@O.BUF]-<1        !OUT LINE CHAR ADDRESSES
       LIMIT_CRONE+80                       !AND LIMIT
! 
       IFNOT ECH THEN GO TO START           !IF EMPTY LINE GO TO PASS TWO 
       IFNOT INT. THEN[                     \IF NOT INTERACTIVE 
         IF GETCR # COLON THEN GO TO EXITF] !MUST HAVE LEAD ":" 
INGL:  SIGN _ 1;  OBUFS,BFEND_BUFPT         !SET UP FOR 
       VAL,T,BF_0                           !SET BLANK STRIP FLAG 
PRAMS: IF GETCR.EQ.DELIM THEN GO TO ENDP    !LOOP TILL DELIMITER
! 
       IF PUTCR THEN GO TO PRAMS            !PASS BLANKS
       IF CHAR = MSIGN THEN  GO TO NGLBL    !LOOK FOR NUMERICS
       IF CHAR = PSIGN THEN GOTO GLBL       !GLOBAL PARAMETERS. 
       IF DIGT THEN GOTO GLBL               !FOUND A DIGIT. 
! 
!     SCAN TO NEXT DELIMITER  IT IS NOT A GLOBAL
! 
TOEND:UNTIL GETCR.EQ.DELIM DO PUTCR         !PASS TILL NEXT PRAM
! 
ENDP: BUFPT_BFEND                           !STRIP TRAILING BLANKS
      IF STOPF THEN GO TO START             !IF EOL THEN GO TO PASS 2 
      PUTCR                                 !ELSE PASS THE DELIMITER
      GO TO INGL                            !ELSE GET NEXT PRAM 
! 
!     SIGN PART OF NUMBER DETECTED  MIGHT BE GLOBAL 
! 
NGLBL:SIGN_ -1                              !IT WAS A "-" SO SET FLAG 
GLBL:  IF GETCR.EQ.DELIM THEN GO TO ENDP    !NOT GLOBAL IF DELIMITER
       IF PUTCR THEN GO TO GLBL             !JUST PASS BLANKS 
       IF DIGT THEN GO TO GLBL              !KEEP A TOTAL OF
       IF CHAR = "G" THEN [                 \LOOK FOR GLOBAL
          GV _ 0;                           \DESIGNATORS. 
          SZ _ 4;  GOTO REPL] 
       IF CHAR = "P" THEN [                 \ 
          GV _ 40;  SZ _ 1;                 \ 
          GOTO REPL]
       GOTO TOEND                           !NOT DIGIT OR "G","P" 
! 
REPL:  IFNOT T THEN GOTO TOEND              !CHECK IF WE HAVE 
      UNTIL GETCR.EQ.DELIM DO[              \PASS ANY TRAILING BLANKS 
         IFNOT PUTCR THEN GO TO TOEND]      !IF OTHER THEN NOT GLOBAL 
! 
!     HONEST TO GOODIE GLOBAL BUT IS IT IN RANGE??
! 
      CBUFS_PTR-1                           !SAVE IN ADD (REREAD DELIMITER) 
       ADD _ VAL * SIGN * SZ + GV           !A REAL GLOBAL. 
       IF  ADD < 0   THEN GO TO EXITF       !CHECK BOUNDS.
       IF  ADD > 47  THEN GO TO EXITF 
       ADD _ ADD + @G0..                    !GET TABLE OFFSET.
       BUFPT,BFEND_OBUFS                    !SET OUTBUF BACK
! 
!     EVALUATE GLOBAL 
! 
      IF SZ # 1 THEN [SZ _ $ADD;ADD_ADD+1]  !IF NOT "P" SET SIZE
      IF SZ = 1 THEN[                       \IF NUMERIC GLOBAL
         VAL_$ADD;                          \CONVERT THE NUMBER 
         IF VAL < 0 THEN[                   \IF NEGATIVE MUST SET 
            VAL_ -VAL;CHAR_MSIGN;           \POSITIVE AND SEND A "-"
            PUTCR                           \  SEND THE "-" 
         ];\
         CALL CNUMD(VAL,P.RAM);             \CONVERT THE NUMBER 
         ADD_ @P.RAM                        \SET RESULT ADDRESS 
      ] 
      IF SZ THEN[                           \IF THERE IS A PARAMETER
         PTR_ADD-< 1;BF,EF_0;               \SET TO MOVE IT IN
         REPEAT 6 TIMES DO [                \ 
            GETCR;PUTCR                     \MOVE A CHARACTER 
         ]  \ 
      ] 
      EF,PTR_CBUFS;GETCR                    !RESET SOURCE POINTER CHAR
      GO TO ENDP                            !GO PROCESS THE DELIMITER 
! 
!  THE SECOND PASS. 
! 
!     INITIALIZE SCAN 
! 
START:BF,CHAR_BLANK                         !PAD LINE IN CASE ODD CHARS 
      EOL_BUFPT-CRONE+CBUFC                 !SET EOL FLAG FOR PASS 2. 
      PUTCR                                 !SEND FINAL CHAR. 
      ECH _(BUFPT-CRONE) >- 1               !SET LINE LENGTH IN WORDS.
      MVW(C.DLM,CBUFA,ECH)                  !MOVE THE BUFFER BACK 
      PTR_CBUFC                             !SET FOR INPUT
      IFNOT SVCOD  THEN[                    \ECHO IF REQUIRED 
         IF C.BUF # "SV" THEN ECHO]         !LET SV ECHO ITS OWN
      CAD._@IN.ER                           !SET CMND ADRS TO INPUT ERROR 
      STOPF,C.DLM_0 
      FOR T_ @N.OPL TO @P.CNT  DO $T_ 0     !ZERO THE OPTION LIST 
      LIMIT_([PRAM_@P.RAM]+64) -< 1         !SET PUTCR LIMIT
      GOTO SCANS                            !GO START THE SCAN
! 
GETCH:UNTIL GETCR.EQ.DELIM DO[ PUTCR;GV_CHAR]!MOVE CHARACTERS UNTIL DELIM 
! 
!     A DELIMITER 0 OR COMMA OR COLON - ENCOUNTERED 
! 
      VAL,T _ 0                             !SET UP FOR NUMERIC CONVERSION
      IF C.DLM THEN GO TO PRMST             !IF WE HAVE A COMMAND GO TO PRAM
      ADD_@C.TAB                            !MUST BE THE COMMAND SO 
      C.DLM_PTR                             !SAVE FIRST DELIMITER ADDRESS 
      U.CMD _ $PLOC                         !SET END OF C.TAB 
      SCR. _ $PLOC1                         ! SAVE CHARS 3,4
      ALWAYS DO[                            \AND LOOK IT UP IN
           IF ($ADD AND 77777K)=$PLOC THEN[  \
              ACM_$ADD;CAD._$(ADD+1);GO TO RPLOC],\ 
           ELSE [ADD_ADD+2]]                !FIND THE PROCESSOR IN TABLE
! 
!     NOT FIRST SO SET UP THE PARAMETER 
! 
PRMST:CBUFS_PTR-1;POS_BUFPT                 !SAVE DELIMITER ADDRESS, END ADD
      IF BUFPT=CUPAD THEN GOTO NULLS        !NULL SO ZERO IT
! 
!     ATTEMPT NUMERIC CONVERSION
! 
      IF GV   = "B" THEN[                   \IF OCTAL SET UP
         BASE_8;POS_POS-1],                 \BASE AND END OF STRING 
      ELSE                                  \OTHER WISE USE 
         BASE_10                            !BASE 10
! 
      PTR_CUPAD;SIGN_1                      !SET FOR LOOP 
! 
!     CONVERSION LOOP 
! 
      UNTIL PTR=POS DO THRU CLOOP 
      IF GETCR= BLANK THEN GOTO CLOOP       !IGNOR IMBEDED BLANKS 
      IFNOT DIGT      THEN [                \IF NOT DIGIT 
         IF PTR=SZ    THEN[                 \IF FIRST CHAR TEST 
             IF CHAR=MSIGN THEN[SIGN_-SIGN;GO TO CLOOP];\ 
             IF CHAR=PSIGN  THEN GO TO CLOOP \
          ];    \ 
          GO TO NOTNO                       \NOT DIGIT OR LEGAL SIGN
      ] 
CLOOP:                                      !END OF CONVERSION LOOP 
! 
!     SET TYPE AND NO. IN THE LIST
! 
      IFNOT [$PLOC0_T] THEN GOTO NOTNO      !IF NO DIGITS-NOT A NUMBER
NULLS:$PLOC_VAL*SIGN                        !SET THE VALUE IN THE LIST
      $[REAL]PLOC1_0.0                      !ZERO THE EXTRA WORDS 
! 
!     SET UP FOR THE NEXT PARAMETER 
! 
NXPRM:PTR_CBUFS;GETCR                       !GET THE DELIMITER
      IFNOT SBSCN THEN GO TO NOTSU          !SKIP IF NOT SUB SCAN 
      IF [SUBCO_SUBCO+1]<3 THEN GOTO STPM   !SKIP ASC TEST IF FIRST TWO 
      IF $PLOC0=3 THEN GO TO SKIPP          !SUB PRAMETERS ELSE ASC ERROR 
STPM: IF P.CNT< 3 THEN$(SBSCN+SUBCO)_$PLOC  !SET THE SUB PRAM IN THE OP LIST
! 
      IF CHAR=COLON THEN[IF SUBCO=5 THEN GOTO SKIPP ,\ TOO MANY 
         ELSE GO TO RPLOC]                  !GO GET NEXT SUB PRAM 
! 
SCANS:SUBCO,SBSCN_0                         !ZERO THE SUB SCAN FLAGS
! 
SCANC:PLOC1_[PLOC_[PLOC0_PRAM+4*P.CNT]+1]+1 !SET THE CURRENT ADDRESSES
! 
RPLOC:SZ_[CUPAD,BUFPT_PLOC -< 1]+1          !SET ADDRESSES FOR PUTCR
      IF CUPAD>LIMIT THEN GO TO EXITF       !TOO MANY PRAMS?
      $PLOC0,$PLOC,$PLOC1_0                 !SET LIST LOCATIONS TO ZERO 
      IF STOPF THEN GO TO EXIT              !IF FINAL DELIMITER EXIT
      GO TO GETCH                           !ELSE GET NEXT PRAM 
! 
!     PARAMETER END NOT SUB PRAM
! 
NOTSU: IF CHAR = COLON THEN [               \CHECK FOR ILLEGAL
          IF P.CNT > 1 THEN [               \DELIMITER, BUT LET 
             IF ACM >  0  THEN[             \IT GO THROUGH IN 
                GOTO EXITF],                \CASE OF SPECIAL
             ELSE[                          \ 
                P.CNT_ P.CNT + 1;           \ 
                GOTO SKIP1]],               \COMMANDS ONLY. 
          ELSE SBSCN _ @INT. + P.CNT*5]     !SET UP SUB-SCAN. 
! 
      P.CNT_P.CNT+1                         !STEP COUNT 
      GO TO SCANC                           !GO SCAN IT 
! 
!     NOT A LEGAL NUMBER - TRY FOR A NAME 
! 
NOTNO:$PLOC0_3                              !ASSUME NAME AND SET UP 
      CHAR_BLANK                            !SET UP TO BLANK FILL 
      UNTIL BUFPT=>CUPAD+6 DO PUTCR         !FILL IT
      GO TO NXPRM                           !ASSUME A NAME  AND CONTINUE
! 
!     NORMAL EXIT ROUTINE   CLEAR END OF LIST AND CHECK FOR SEG 
! 
EXIT: CHAR_0
      UNTIL BUFPT >= LIMIT DO PUTCR         !ZAP THE LIST 
      IF CAD.<0 THEN GO TO EXIT1            !IF LOCAL GO EXIT 
      IF CAD.>10000K THEN GO TO EXIT1       !IF LOCAL GO TO EXIT. 
      CHAR,CUSE._(CAD. AND 377K)-<8         !SET SEGMENT ADRS INTO CUSE 
! 
      CAD._((CAD. AND 17400K)-<8)           !SET ROUTINE NUMBER IN CAD. 
EXIT1:.B._ACM                               !SET ASCII COMMAND IN B FOR MAIN
      IFNOT CHAR THEN RETURN,ELSE FRETURN 
! 
EXITF:IF ACM<0 THEN GO TO EXIT              !IF WE HAVE A SPECIAL THEN EXIT 
EXITG:IFNOT EF THEN PTR_CBUFS               !IF ERROR WHILE PTR WRONG RESET 
      CAD._@IN.ER;CHAR_0;GO TO EXIT1        !ELSE ERROR EXIT
! 
! 
!     PARSE ERROR ON SUBPARAMETER.  IF SPECIAL COMMAND, 
!     IGNORE EVERYTHING UNTIL NEXT COMMA OR END OF LINE IS
!     FOUND.
! 
SKIPP:IF ACM >= 0  THEN GOTO EXITG          !IFNOT SPECIAL, EXIT
SKIP1:IF CHAR = COLON  THEN[                \FLUSH THE SUB PARMS
SKIP2:   IFNOT GETCR.EQ.DELIM  THEN         \ 
            GOTO SKIP2;                     \SKIP UNTIL NEXT DELIMITER
         IF STOPF  THEN  GOTO EXIT,         \EXIT IF END OF LINE
         ELSE GOTO SKIP1]                   !GO CHECK FOR ANOTHER SUBP
      GOTO SCANS                            !WHEN COMMA, CONTINUE 
      END 
! 
IN.ER:SUBROUTINE
      MSS.(10)                              !FORCE ECHO AND PRINT ERROR 
      BUFPT_PTR;CHAR_QUES;PUTCR             !PLANT A "?"
      CHAR_BLANK;PUTCR                      !AND A BLANK PAD
      FM.ER(1,C.BUF,(BUFPT-CBUFC)>-1)       !WRITE IT OUT 
      RETURN
      END 
      END 
      END$
                                                                                                                                                    