SPL,L,O,M 
!     NAME:   .PARS 
!     SOURCE: 92071-18011 
!     RELOC:  92070-16011 
!     PGMR:   G.A.A., A.M.G 
!     MOD:    E.D.B.
! 
!  ***************************************************************
!  * (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(7) "92071-1X011 REV.2041 800630" 
! 
!     THE .PARS ROUTINE AND ITS SUBROUTINES SCAN AN ASCII 
!     STRING (IN C.BUF) AND PRODUCES: 
! 
!     1.  AN ACTION ROUTINE ADDRESS (CAD.,CUSE.)
!     2.  A PARAMETER COUNT (P.CNT) 
!     3.  A PARAMETER LIST  (P.RAM) WITH 4 WORDS FOR EACH PARAMETER 
! 
!         1.  PARAMETER TYPE: 
!             0 - NULL
!             1 - NUMBER
!             1 - SIGNED OR OCTAL NUMBER
!             3 - ASCII STRING (THREE CHARACTERS) 
! 
!         2.  FOR TYPE 1, THE NUMERIC VALUE;
!             FOR TYPE 3, CHARACTERS 1 AND 2. 
! 
!         3.  FOR TYPE 3, CHARACTERS 3 AND 4. 
! 
!         4.  FOR TYPE 3, CHARACTERS 5 AND 6. 
! 
!     4.  A SUBPARAMETER OPTION LIST(N.OPL) 
!         SUBPARAMETER MAY BE SUPPLIED FOR THE FIRST TWO PARAMETERS.
!         THEY ARE SEPARATED FROM EACH OTHER AND FROM 
!         THE PARAMETER ITSELF BY COLONS. 
!         EACH SUBPARAMETER IS STORED IN N.OPL STARTING AT
!         WORD ZERO FOR PARAMETER ONE AND WORD 5 FOR PARAMETER TWO. 
!         THERE MAY BE ONLY FIVE SUBPARAMETERS PER PARAMETER. 
!         THE FIRST TWO SUBPARAMETERS MAY BE ASCII,THE REST 
!         MUST BE NUMERIC.
! 
!     THE COMMAND IS SEPARATED FROM THE PARAMETERS BY A COMMA OR COLON. 
!     PARAMETERS ARE SEPARATED FROM OTHER PARAMETERS BY COMMAS. 
!     BLANKS ARE IGNORED UNLESS THEY ARE WITHIN ASCII STRINGS.
!     THE FIRST CHARACTER MUST BE ":" IF INPUT IS NOT FROM A TTY. 
! 
!  EXTERNAL VARIABLES 
      LET INT.,    \INTERACTIVE INPUT FLAG
          N.OPL,   \SUBPARAMETER LIST 
          P.RAM,   \PARAMETER LIST ARRAY
          P.CNT,   \NUMBER OF PARAMETERS FOUND
          G0..,    \GLOBAL ARRAY
          CAD.,    \COMMAND ADDRESS 
          ECH,     \INPUT COMMAND LENGTH (WORDS) RESET FOR ECHO 
          C.DLM,   \CHARACTER ADDRESS OF FIRST DELIMITER AFTER COMMAND
          C.TAB,   \COMMAND TABLE ADDRESS 
          CUSE.,   \CURRENT SEGMENT SUFFIX CHARACTER
          C.BUF,   \COMMAND BUFFER
          O.BUF,   \OUTPUT DCB, USED AS A WORKING BUFFER
          U.CMD,   \CHARACTERS 1 AND 2 OF COMMAND 
          SCR.     \CHARACTERS 3 AND 4 OF COMMAND (OR 0 IF NONE)
                BE INTEGER,EXTERNAL 
! 
!  EXTERNAL SUBROUTINES 
      LET FM.ER,   \PRINT ERROR MESSAGE ROUTINE 
          CNUMD,   \NUMBER TO ASCII CONVERSION ROUTINE
          MSS.,    \ERROR MESSAGE ROUTINE 
          MVW      \FMGR MOVE WORDS SUBROUTINE
                BE SUBROUTINE,EXTERNAL
! 
!  GLOBAL SUBROUTINES 
      LET IN.ER BE SUBROUTINE,GLOBAL
! 
!  INTERNAL CONSTANTS 
      LET PARSG BE CONSTANT(30440K)              !"1 "
! 
GETCR: FUNCTION DIRECT
! 
!     GETS A CHARACTER FROM BUFFER AT G.PTR (BYTE POINTER), 
!     AND RETURNS IT INTO A-REG 
! 
      .B._G.PTR                                  !CHARACTER ADDRESS TO B
! 
      ASSEMBLE["CLE,ERB";                        \MEM ADDRESS TO B,BYTE TO E
               "LDA 1,I";                        \GET THE WORD
               "ELB";                            \RESTORE MEM ADDRESS 
               "SLB,INB,RSS";                    \STEP ADDR, SKIP IF HIGH 
               "ALF,ALF"  ]                      !ROTATE TO LOW IF NEEDED 
! 
      G.PTR_ .B.                                 !RESTORE B TO POINTER
      .A.,CHAR_.A. AND 377K                      !ISOLATE CHARACTER AND SAVE
      RETURN .A.                                 !DONE GET OUT
      END 
! 
PUTCR:FUNCTION DIRECT 
! 
!     PUTS A CHARACTER INTO BUFFER AT P.PTR (BYTE POINTER)
! 
      IF [.B._P.PTR]=P.EOL THEN [                \IF NO ROOM
          IF SPCL THEN RETURN 0,                 \CHECK IF SPECIAL
                  ELSE GOTO EXITG]               !OTHERWISE FAIL
! 
      .A._CHAR                                   !CHAR TO A FOR ASSMBLY 
      ASSEMBLE["CLE,ERB";                        \MEM ADDRESS TO B,BYTE TO E
               "XOR 1,I";                        \KEEP OLD HIGH CHAR IN CASE
               "AND =B377";                      \THIS IS LOW 
               "XOR 1,I";                        \MERGE IN NEW CHAR 
               "SEZ,RSS";                        \IF UPPER
               "ALF,ALF";                        \ROTATE
               "STA 1,I";                        \STASH IT AWAY 
               "ISZ P.PTR" ]                     !PUSH BUFFER POINTER BACK
! 
      IF CHAR = " " THEN [                       \IF FIRST BLANK AFTER
         IFNOT BF THEN P.PTR_ P.PTR-1;           \BF SET TO ZERO
         RETURN 1],                              \RETURN TRUE FOR ALL BLANKS
      ELSE [                                     \NOT A BLANK 
         BF,BFEND_P.PTR;                         \KEEP HIGHEST NON BLANK
         RETURN 0]                               !RETURN ZERO 
      END 
! 
USHFT:FUNCTION(CHR) DIRECT
! 
!     CONVERT A CHARACTER (POSSIBLY LOWER CASE) INTO UPPER CASE ONLY
! 
!**   IF (CHR AND 177K) > 140K THEN[             \IF CHARACTER WITHIN 
!**       IF (CHR AND 177K) < 173K THEN          \ LOWER CASE RANGE,
!**           CHR_ CHR AND 177737K]              !STRIP LOWER-CASE BIT
      RETURN CHR                                 !AND RETURN CHR
      END 
! 
GETCR.EQ.DELIM:FUNCTION DIRECT
! 
!     RETURNS TRUE IF NEXT CHARACTER IS DELIMITER 
!             FALSE IF NOT
!     ALSO SETS UP CHAR AND STOPF 
! 
      IF G.PTR=G.EOL THEN [                      \IF END OF LINE
         STOPF,CHAR_ 1;                          \SET STOP FLAG AND 
         RETURN 1]                               !EXIT TRUE 
      IF GETCR = ":" THEN RETURN 1               !ELSE GET CHAR AND 
      IF CHAR = ","  THEN RETURN 1               !IF ":" OR "," EXIT TRUE 
      RETURN 0                                   !EXIT FALSE NOT A DELIMITER
      END 
! 
DIGT: FUNCTION DIRECT 
! 
!     RETURNS TRUE IF CHAR IS A DIGIT 
!     ALSO SETS UP VAL (CURRENT VALUE) AND T (INDICATES VAL VALID)
! 
      IF [CRAC_ CHAR-"0" ] >= 0 THEN[            \IF GREATER THAN "0" AND 
          IF CRAC < BASE THEN [                  \LESS THAN BASE, 
              VAL_VAL*BASE+CRAC;                 \THEN ADD NUMBER,
              RETURN [T_ 1]]]                    !RETURN TRUE 
      RETURN 0                                   !ELSE RETURN FALSE 
      END 
! 
SKIPP:SUBROUTINE
! 
!     PARSE ERROR ON SUBPARAMETER.  IF SPECIAL COMMAND, 
!     IGNORE EVERYTHING UNTIL NEXT COMMA OR END OF LINE IS FOUND. 
! 
      IFNOT SPCL THEN GOTO EXITG                 !IFNOT SPECIAL, EXIT 
! 
SKIP1:IF CHAR = ":" THEN [                       \FLUSH THE SUB PARMS 
          UNTIL GETCR.EQ.DELIM DO [];            \SKIP CHARACTERS 
          IF STOPF THEN GOTO EXIT,               \IF END OF LINE, EXIT
                   ELSE GOTO SKIP1]              !ELSE GO CHECK FOR ANOTHER 
      RETURN                                     !WHEN COMMA, CONTINUE
      END 
! 
.PARS:SUBROUTINE GLOBAL,FEXIT 
! 
!     PARSE A COMMAND 
! 
      CBUF_ @C.BUF; OBUF_ @O.BUF                 !SET BUFFER ADDRESSES
      BASE_10                                    !SET DEFAULT BASE
      SPCL,STOPF _ 0; EF_ -1                     !SET FLAGS 
      G.EOL_ [G.PTR_ CBUF-<1]+ECH+ECH            !SET INPUT ADDRESSES 
      P.EOL_ [P.PTR,CRONE_ OBUF-<1]+80           !SET OUTPUT ADDRESSES
! 
      IFNOT ECH THEN GOTO PASS2                  !IF EMPTY LINE DO PASS 2 
      IFNOT INT. THEN[                           \IF NOT INTERACTIVE
         IF GETCR # ":" THEN GOTO EXITF]         !MUST HAVE LEAD ":"
! 
!     PASS ONE: TRANSLATE GLOBAL PARAMETERS AND REMOVE EXTRANEOUS 
!               BLANKS. ALSO, REMOVE NON-INTERACTIVE PROMPT CHARACTER.
! 
INGL: SIGN _ 1;  OBUFS,BFEND_P.PTR               !SET UP FOR
      VAL,T,BF_0                                 !SET BLANK STRIP FLAG
! 
PRAMS:IF GETCR.EQ.DELIM THEN GOTO ENDP           !LOOP TILL DELIMITER 
      IF PUTCR         THEN GOTO PRAMS           !PASS BLANKS 
      IF DIGT          THEN GOTO GLBL            !LOOK FOR DIGIT
      IF CHAR = "-"    THEN [SIGN_ -1; GOTO GLBL] !LOOK FOR MINUS SIGN
      IF CHAR = "+"    THEN GOTO GLBL            !LOOK FOR PLUS SIGN
      GOTO TOEND
! 
!     PART OF NUMBER DETECTED; CHECK FOR GLOBAL 
! 
GLBL: IF GETCR.EQ.DELIM  THEN GOTO ENDP          !NOT GLOBAL IF DELIMITER 
      IF PUTCR           THEN GOTO GLBL          !JUST PASS BLANKS
      IF DIGT            THEN GOTO GLBL          !KEEP A TOTAL OF 
      IF USHFT(CHAR)="G" THEN [                  \LOOK FOR GLOBAL 
          GV_ 0; SZ_ 4;                          \DESIGNATORS.
          GOTO REPL]                             !
      IF USHFT(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 GOTO TOEND]            !IF OTHER THEN NOT GLOBAL
! 
!     WHOLE GLOBAL FOUND; CHECK FOR PROPER RANGE
! 
      CBUFS_G.PTR-1                              !SAVE ADDR (TO GET DELIM)
      ADD _ VAL * SIGN * SZ + GV                 !A REAL GLOBAL.
      IF  ADD < 0   THEN GOTO EXITF              !CHECK BOUNDS. 
      IF  ADD > 47  THEN GOTO EXITF 
      ADD _ ADD + @G0..                          !GET TABLE OFFSET. 
      P.PTR,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 
         IF [VAL_ $ADD] < 0 THEN [               \IF NEGATIVE MUST
            VAL_ -VAL;                           \SET POSITIVE
            CHAR_ "-"; PUTCR];                   \ AND SEND THE "-" 
         CALL CNUMD(VAL,P.RAM);                  \CONVERT THE NUMBER
         ADD_ @P.RAM]                            !SET RESULT ADDRESS
! 
      IF SZ THEN[                                \IF THERE IS A PARAMETER 
         G.PTR_ ADD-<1; BF,EF_ 0;                \SET TO MOVE IT IN 
         REPEAT 6 TIMES DO [                     \
            GETCR; PUTCR]]                       !MOVE A CHARACTER
! 
     EF,G.PTR_ CBUFS                            !RESET SOURCE POINTER CHAR
      GETCR 
      GOTO ENDP                                  !GO PROCESS THE DELIMITER
! 
!     SCAN TO NEXT DELIMITER; IT IS NOT A GLOBAL
! 
TOEND:UNTIL GETCR.EQ.DELIM DO PUTCR              !PASS TILL NEXT PRAM 
! 
ENDP: P.PTR_ BFEND                               !STRIP TRAILING BLANKS 
      IFNOT STOPF THEN [PUTCR; GOTO INGL]        !IFNOT EOL, GET NEXT PARM
! 
!     PASS TWO: BUILD PARAMETER AND SUBPARAMETER LISTS
! 
PASS2:G.EOL_ [G.PTR_ CBUF-<1]+(P.PTR-CRONE)      !SET INPUT ADDRESSES 
      BF,CHAR_ " "; PUTCR                        !PAD COMMAND WITH BLANK
      ECH_ (P.PTR-CRONE)>-1                      !SET LINE LENGTH IN WORDS
      MVW(OBUF,CBUF,ECH)                         !MOVE THE BUFFER BACK
! 
      IF (C.BUF/400K)="*" THEN GOTO EXITC        !CHECK FOR COMMENT LINE
! 
      STOPF,C.DLM_ 0
      FOR T_ @N.OPL TO @P.CNT  DO $T_ 0          !ZERO THE OPTION LIST
      P.EOL_ ([PRAM_ @P.RAM]+64)-<1              !SET PUTCR LIMIT 
! 
SCANS:SUBCO,SBSCN_0                              !ZERO THE SUB SCAN FLAGS 
! 
SCANC:PLOC3_[PLOC2_[PLOC1_[PLOC0_PRAM+4*P.CNT]+1]+1]+1 !SET PARM ADDRESSES
! 
RPLOC:SZ_ [P.BEG,P.PTR_ PLOC1-<1]+1              !SET ADDRESSES FOR PUTCR 
      IF P.BEG>P.EOL THEN GOTO EXITF             !TOO MANY PRAMS? 
      $PLOC0,$PLOC1,$PLOC2,$PLOC3_ 0             !CLEAR PARM LOCATIONS
      IF STOPF THEN GOTO EXIT                    !IF FINAL DELIMITER EXIT 
! 
!     GET A CHARACTER FROM INPUT LINE 
! 
GETCH:UNTIL GETCR.EQ.DELIM DO [                  \MOVE CHARS UNTIL DELIM
          GV,CHAR_ USHFT(CHAR); PUTCR]
      IF C.DLM THEN GOTO PRMST                   !CHECK FOR COMMAND 
! 
!     LOCATE COMMAND
! 
      C.DLM_G.PTR                                !SAVE FIRST DELIM ADDRESS
      U.CMD_ $PLOC1; SCR._ $PLOC2                !SAVE COMMAND NAME 
      IF SCR. THEN GOTO IMPRU                    !CHECK FOR PROGRAM 
! 
      ADD_ @C.TAB                                !GET COMMAND TABLE ADDRESS 
      UNTIL $ADD+1=0 DO [                        \LOOK IT UP IN C.TAB 
          IF ($ADD AND 77777K)=U.CMD THEN [      \
              SPCL_ $ADD AND 100000K;            \
              CAD._ $(ADD+1);                    \
              GOTO RPLOC];                       \
          ADD_ ADD+2]                            !
! 
!     COMMAND NOT FOUND; TRY IMPLICIT RUN 
! 
IMPRU:G.PTR_ CBUF-<1; P.PTR_ OBUF-<1             !RESET BUFFER POINTERS 
      CHAR_ "R"; PUTCR; CHAR_ "U"; PUTCR         !PUT "RU," IN BUFFER 
      CHAR_ ","; PUTCR; 
      UNTIL G.PTR=> G.EOL DO [GETCR; PUTCR]      !PUT REST OF COMMAND 
      GOTO PASS2                                 !IN BUFFER AND CONTINUE
! 
!     SET UP PARAMETER
! 
PRMST:CBUFS_ G.PTR-1                             !SAVE DELIM ADDR 
      IF P.PTR=P.BEG THEN GOTO NXPRM             !NULL SO ZERO IT 
! 
!     ATTEMPT NUMERIC CONVERSION
! 
      IF GV="B" THEN [BASE_ 8; POS_ P.PTR-1],    \USE OCTAL  (BASE 8) 
                ELSE [BASE_ 10; POS_ P.PTR]      !OR DECIMAL (BASE 10)
! 
      VAL,T_ 0; SIGN_ 1                          !SET UP FOR CONVERSION 
      G.PTR_ P.BEG;                              !BACK UP INPUT POINTER 
      UNTIL G.PTR=POS DO [                       \CONVERSION LOOP 
          IFNOT GETCR = " " THEN [               \IGNORE IMBEDDED BLANKS
              IFNOT DIGT THEN [                  \IF NOT DIGIT
                  IFNOT G.PTR=SZ THEN GOTO NOTNO; \CHECK IF NOT FIRST CHAR
                  SIGN_ 0;                       \RESET SIGN
                  IF CHAR="-" THEN SIGN_ -1;     \CHECK FOR MINUS SIGN
                  IF CHAR="+" THEN SIGN_ 1;      \CHECK FOR PLUS SIGN 
                  IFNOT SIGN  THEN GOTO NOTNO]]] !CHECK IF SIGN SET 
      IFNOT T THEN GOTO NOTNO                    !IF NO DIGITS-NOT A NUMBER 
! 
!     SET NUMBER INTO PARAMETER LIST
! 
      $PLOC0_ 1                                  !SET THE TYPE IN THE LIST
      $PLOC1_ VAL*SIGN; $PLOC2_ 0; $PLOC3_ 0     !SET THE VALUES IN THE LIST
      GOTO NXPRM
! 
!     NOT A LEGAL NUMBER; ASSUME ASCII
! 
NOTNO:$PLOC0_3                                   !SET THE TYPE IN THE LIST
      CHAR_ " "                                  !FILL REMAINING WORDS
      UNTIL P.PTR=>P.BEG+6 DO PUTCR              ! WITH BLANKS
! 
!     SET UP FOR THE NEXT PARAMETER 
! 
NXPRM:G.PTR_ CBUFS; GETCR                        !GET THE DELIMITER 
! 
      IFNOT SBSCN THEN GOTO NOTSU                !IFNOT SUB SCAN, THEN CONT 
      IF P.CNT>2 THEN [SKIPP; GOTO SCANS]        !IF PAST SECOND PARM, IGNORE 
  
      IF SUBCO=5 THEN [SKIPP; GOTO SCANS]        !IF PAST FIFTH SUBPARM, IGNOR
  
      IF [SUBCO_SUBCO+1]>2 THEN [                \IF PAST SECOND SUBPARM, 
          IF $PLOC0=3 THEN [SKIPP; GOTO SCANS]]  !AND IF ASCII, THEN IGNORE 
      $(SBSCN+SUBCO)_ $PLOC1                     !SET SUBPARM IN N.OPL
! 
      IF CHAR = ":" THEN GOTO RPLOC,             \IF FOUND COLON, GO DO IT
                    ELSE GOTO SCANS              !OTHERWISE CONTINUE
! 
!     MAIN PARAMETER FOUND; CHECK FOR SUB SCAN
! 
NOTSU: IF CHAR = ":" THEN                        \IF SUBPARM DELIMITER, 
           SBSCN _ @N.OPL+P.CNT*5-1              ! SET UP SUB SCAN
      P.CNT_P.CNT+1                              !STEP COUNT
      GOTO SCANC                                 !GO SCAN IT
! 
!     EXIT CODE; CLEAR END OF LIST AND CALCULATE COMMAND ADDRESS
! 
EXITF:IFNOT SPCL THEN GOTO EXITG                 !CHECK IF NOT SPECIAL
! 
EXIT: CHAR_ 0                                    !CLEAR REMAINDER OF
      UNTIL P.PTR >= P.EOL DO PUTCR              ! PARAMETER LIST 
! 
      CUSE._ CAD. AND 177400K                    !CALCULATE SEGMENT ADDRESS 
      CAD._  CAD. AND 377K                       !CALCULATE ROUTINE NUMBER
      RETURN                                     \AND RETURN
! 
EXITC:CAD._ 2; CUSE._ PARSG                      !SET COMMENT ADDRESS 
      RETURN
! 
EXITG:IFNOT EF THEN G.PTR_ CBUFS                 !IF ERROR WHILE G.PTR WRONG
      CAD._ 1; CUSE._ PARSG                      !SET BAD COMMAND ADDRESS 
      RETURN
      END 
! 
IN.ER:SUBROUTINE GLOBAL 
! 
!     PRINT INPUT ERROR MESSAGE 
! 
      MSS.(10)                                   !PRINT FMP ERROR MESSAGE 
      P.PTR_ G.PTR                               !SET OUTPUT ADDRESS
      CHAR_ "?"; PUTCR; CHAR_ " "; PUTCR         !PUT "? " IN BUFFER
      FM.ER(1,C.BUF,(P.PTR>-1)-@C.BUF)           !WRITE IT OUT
      RETURN
      END 
! 
      END 
      END$
                                                                                                                          