SPL,L,O 
!     NAME:   .PARS 
!     SOURCE: 92067-18207 
!     RELOC:  92067-16185 
!     PGMR:   G.A.A.,A.M.G.,B.L.
! 
!  ***************************************************************
!  * (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) "92067-16185 REV.2001 791022"
! 
!  MODIFICATION RECORD: 
! 
!      DATE     REASON
!  1) 780227    TO ALLOW GLOBALS 8P,9P (BL) 
!  2) 780414    SESSION MONITOR COMMAND CAPABILITY CHECKING (BL)
!  3) 790119    TO BACK UP BUFFER ON EXITE FROM PASS 1 (BL) 
!  4) 790510    TO INHIBIT SESSION PASSWORD ECHO FOR JO 
!  5) 790510    TO UPSHIFT LOWER CASE COMMANDS (COMMENTED FOR FUTURE) 
! 
! 
!     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 SEPARATED 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 PARAMETERS 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 TTY.,    \INTERACTIVE INPUT FLAG
          N.OPL,   \NAMR SUBPARAMETER LIST
          .E.R.,   \ADDRESS LESS 1 OF SV CODE 
          P.RAM,   \PARAMETER LIST ARRAY
          NOCM.,   \NUMBER OF PARAMETERS FOUND
          G0..,    \GLOBAL ARRAY
          CAD.,    \COMMAND FOUND (ADDRESS OR INDEX IF IN SEGMENT)
          ECH.,    \INPUT COMMAND LENGTH(WORDS) RESET FOR EC.HO 
          ACTV.,   \ACTIVE FLAG (INDEX TO TR STACK) 
          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)
          OVRD.,   \CARTRIDGE SEARCH OVERRIDE WORD
          S.CAP    \GLOBAL 9P (SESSION CAPABILITY LEVEL)
                 BE INTEGER,EXTERNAL
      LET CAPCK    \CAPABILITY CHECK ROUTINE
                 BE FUNCTION,EXTERNAL 
      LET FM.ER,   \PRINT ERROR MESSAGE ROUTINE 
          EC.HO,   \ECHO THE COMMAND ROUTINE
          CNUMD,   \NUMBER TO ASCII CONVERSION ROUTINE
          MSS.     \ERROR MESSAGE ROUTINE 
                 BE SUBROUTINE,EXTERNAL 
      LET IN.ER,   \INPUT ERROR 
          CP.ER,   \CAPABILITY ERROR
          JO.ER    \JO MISSING ERROR
                BE SUBROUTINE 
      LET COLON BE CONSTANT(72K ) 
      LET BLANK BE CONSTANT(40K ) 
      LET COMMA BE CONSTANT (54K )
      LET CHAR0 BE CONSTANT(60K ) 
      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 
      CHAR_.A. AND 377K                     !ISOLATE THE CHARACTER AND SAVE 
!     IF PAS2 THEN [                        \IF PASS 2 AND
!        IF CHAR>140K THEN [                \IF A LOWER CASE CHAR 
!           IF CHAR<173K THEN               \THEN 
!              CHAR_CHAR AND 737K]]         !SHIFT IT TO UPPER CASE 
      RETURN CHAR                           !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
! 
      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                   \IF ":" OR "," EXIT TRUE
         [PRCNT_PRCNT+1;GO TO DELT] 
      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 
       PAS2,ACM,STOPF,PRCNT _ 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 
       BUFPT,CRONE_[C.DLM_@O.BUF]-<1        !OUT LINE CHAR ADDRESSES
       LIMIT_CRONE+80                       !AND LIMIT
       JOF,O.BUF_0                          !CLEAR 1ST WORD OF PARSE
! 
       IFNOT ECH. THEN GO TO START          !IF EMPTY LINE GO TO PASS TWO 
       IFNOT TTY. 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:IF JOF THEN [                         \IF "JO" THEN 
         IF PRCNT=2 THEN [                  \AND IF 2ND PARAMETER 
            IF CHAR="/" THEN [              \AND IF PASSWORD FOLLOWS
               UNTIL GETCR.EQ.DELIM DO [];  \SKIP CHARACTERS
               GO TO ENDP]]]                ! 
      IFNOT GETCR.EQ.DELIM THEN             \PASS TILL NEXT PRAM
         [PUTCR;GO TO TOEND]
! 
ENDP: BUFPT_BFEND                           !STRIP TRAILING BLANKS
      IF STOPF THEN GO TO START             !IF EOL THEN GO TO PASS 2 
      PUTCR                                 !ELSE PASS THE DELIMITER
      IF O.BUF="JO" THEN JOF_1
      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. 
SETSZ:    SZ _ 4;  GOTO REPL] 
       IF CHAR = "S" THEN [                 \ 
          GV _ -8;  GOTO SETSZ] 
       IF CHAR = "P" THEN [                 \ 
          GV _ 40;  SZ _ 1;                 \ 
          GOTO REPL]
       GOTO TOEND                           !NOT DIGIT OR "S","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 < -8  THEN GO TO EXITE       !CHECK BOUNDS.
       IF  ADD > 47  THEN [                 \ 
          IF (ADD > 49 OR SZ = 4)           \ALLOW 8P,9P        *780227*
          THEN GO TO EXITE] 
       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 
      PAS2_1
      EOL_BUFPT-CRONE+CBUFC                 !SET EOL FLAG FOR PASS 2. 
      PUTCR                                 !SEND FINAL CHAR. 
      ECH._(BUFPT-CRONE) >- 1               !SET LINE LENGTH IN WORDS.
      ASSEMBLE["LDA C.DLM";                 \SET UP FOR .MVW
               "LDB CBUFA";  \
               "EXT .MVW" ;  \
               "JSB .MVW";                  \MOVE THE BUFFER BACK 
               "DEF ECH.";    \ 
               "NOP"          ] 
      PTR_CBUFC                             !SET FOR INPUT
      IFNOT $(@.E.R.+1) THEN [              \ECHO IF REQUIRED 
         IF C.BUF # "SV" THEN EC.HO         \LET SV ECHO ITS OWN
      ] 
      CAD._@IN.ER 
      STOPF,C.DLM_0 
      FOR T_ @N.OPL TO @NOCM. DO $T_0  !ZERO THE OPTION LIST
      LIMIT_([PRAM_@P.RAM]+64) -< 1         !SET PUTCR LIMIT
      GO TO 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
      IF ACTV. = 1 THEN [                   \IF ACTIVE FLAG AND 
         IF $PLOC # "JO" THEN               \AND NOT A JO COMMAND,
            [CAD._@JO.ER;                   \ERROR, EXPECTING JO
             CHAR_0;                        \ 
             GO TO EXIT1]]                  !EXIT 
!                                           !                     *780414*
      C.DLM_PTR                             !SAVE FIRST DELIMITER ADDRESS 
      SCR. _ $PLOC1                         ! SAVE CHARS 3,4
      IFNOT S.CAP THEN[                     \IF NON-SESSION       *780414*
         ADD_C.TAB;                         \COMMAND TABLE ADDR.  *780414*
         ALWAYS DO[                         \LOOK IT UP 
           IF ($ADD AND 77777K)=$PLOC THEN  \                     *780414*
              GO TO ALLOW,                  \                     *780414*
           ELSE [ADD_ADD+2;                 \FIND THE PROCESSOR IN TABLE
           IFNOT $ADD THEN GOTO EXITF       \IF ZERO THEN NOT FOUND 
           ]]]
! 
!     SESSION MONITOR COMMAND CAPABILITY CHECKING                 *780414*
! 
!  METHOD:  1) SEARCH LEVEL DESCRIPTION PART OF C.TAB UNTIL A LEVEL 
!              NUMBER GREATER THAN USER'S CAPABILITY IS FOUND.
!           2) SEARCH UNTIL COMMAND FOUND OR UNTIL THIS LEVEL NUMBER
!              IS REACHED.  IF COMMAND IS FOUND, ALLOW IT, ELSE 
!           3) SEARCH FOR COMMAND THROUGH HIGHEST CAPABILITY LEVEL. 
!              IF FOUND, RETURN INSUFFICIENT CAPABILITY ERROR, ELSE 
!           4) SEARCH FOR COMMAND THROUGH SPECIAL BREAK MODE COMMANDS 
!              SECTION.  IF FOUND, LET CAPCK DO CAPABILITY CHECKING,
!              ELSE RETURN UNDEFINED COMMAND. 
!           5) NOTE, IF THE OVERRIDE FLAG IS SET, THE COMMAND IS
!              ALLOWED, EVEN IF THE USER HAS A LOWER CAPABILITY.
! 
!  C.LVL INDICATES STOPPING POINT IN THE TABLE FOR THE CURRENT SEARCH 
! 
      OVRD_OVRD. AND 40000K                  !GET BIT 14 SET BY TR *780414* 
      ADD_[SCMD_[ENDS_[C.LVL_@C.TAB]+1]+1]+1 !DEFINE PTRS. TO C.TAB 
      IF ADD = $ENDS THEN C.LVL_SCMD         !ALLOW ALL IF NO LEVEL PART
      WHILE (ADD # $ENDS AND $ADD <= S.CAP)  \SCAN LEVEL PART OF COMMAND
         DO [ADD_[C.LVL_ADD+1]+1]           !UNTIL HIGHER CAPABILITY OR 
      ADD_C.TAB                             !END OF LEVEL PART REACHED
      WHILE (ADD # $C.LVL)                  \SEARCH THRU THIS CAP. LEVEL
         DO [IF($ADD AND 77777K)=$PLOC THEN   \IF COMMAND FOUND 
            GO TO ALLOW,                      \SET COMMAND ADDRESS
            ELSE ADD_ADD+2]                   !OTHERWISE CONTINUE SEARCH
! 
      C.LVL_$SCMD                           !NOT FOUND BEFORE CAP. LEVEL
      WHILE (ADD # C.LVL)                   \SEARCH THRU HIGHER CAP.LEVELS
         DO [IF($ADD AND 77777K)=$PLOC THEN \IF COMMAND FOUND 
              [IFNOT OVRD THEN GO TO NOCAP, \IF NO OVERRIDE, CAPAB.TOO LOW
               ELSE GO TO ALLOW],           \OVERRIDE SET, ALLOW COMMAND
            ELSE ADD_ADD+2]                 !OTHERWISE CONTINUE SEARCH
! 
      C.LVL_$$ENDS                          !NOT FOUND IN ANY CAP.LEVEL 
      WHILE (ADD # C.LVL)                   \SEARCH BREAK MODE COMMANDS 
         DO [IF($ADD AND 77777K)=$PLOC THEN[   \IF COMMAND FOUND
              REGA_CAPCK($CBUFA,ECH.<-1);      \CAPABILITY CHECK ROUTINE
              REGB_.B.;                        \B NEGATIVE IF CAP TOO LOW 
              IF REGA = -1 THEN GO TO EXITF;   \RETURN UNDEFINED COMMAND
              IF(REGB < 0 AND OVRD = 0) THEN   \IF CAP.TOO LOW & NO OVRD
                 GO TO NOCAP,                  \INSUFFICIENT CAPABILITY 
                 ELSE GO TO ALLOW],            \ALLOW THE COMMAND 
            ELSE ADD_ADD+2]                    !CONTINUE SEARCH 
      GO TO EXITF 
! 
ALLOW:ACM_$ADD                              !SET COMMAND ADDRESS
      CAD._$(ADD+1) 
      GO TO RPLOC 
! 
NOCAP:CAD._@CP.ER                           !INSUFFICIENT CAPABILITY
      CHAR_0
      GO TO EXIT1 
! 
!     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       !IGNORE IMBEDDED 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 PARAMETERS ELSE ASC ERROR
STPM: IF NOCM.< 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*NOCM.]+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 NOCM. > 1 THEN [               \DELIMITER, BUT LET 
             IF ACM >  0 THEN               \IT GO THROUGH IN 
                GOTO EXITF,ELSE             \CASE OF SPECIAL CMDS 
                [NOCM._NOCM.+1;GOTO SKIP1]],\ 
          ELSE SBSCN _ @TTY. + NOCM.*5]     !SET UP SUB-SCAN. 
! 
      NOCM._NOCM.+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 
! 
      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 
! 
EXITE:PUTCR                                 !SEND FINAL CHARACTER 
      ECH._(BUFPT-CRONE) >- 1               !SET LINE LENGTH
      PTR_CBUFC+(ECH.*2)                    !ADJUST BACKED-UP BUFFER
      ASSEMBLE ["LDA C.DLM";                \SET ADDRESSES FOR .MVW 
                "LDB CBUFA";                \ 
                "JSB .MVW";                 \BACK UP THE COMMAND BUFFER 
                "DEF ECH.";                 \BUFFER LENGTH
                "NOP"]                      ! 
! 
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
! 
SKIPP:IF ACM >= 0 THEN GO TO EXITG          !IFNOT SPECIAL, EXIT
SKIP1:IF CHAR=COLON THEN [                  \FLUSH THE SUBPARMS 
SKIP2: IFNOT GETCR.EQ.DELIM THEN GOTO SKIP2; \SKIP TO NEXT DELIMITER
       IF STOPF THEN GOTO EXIT,              \EXIT IF END OF LINE 
          ELSE GOTO SKIP1]                   !CHECK FOR ANOTHER SUBP
      GOTO SCANS                             !CONTINUE WHEN "," FOUND 
      END 
! 
CP.ER:SUBROUTINE                            !                   *780414*
      MSS.(46)                              !INSUFFICIENT CAPABILITY
      RETURN
      END 
! 
JO.ER:SUBROUTINE
      MSS.(74)                              !JO COMMAND EXPECTED
      RETURN
      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$
                                                          