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$