C C C C COPYRIGHT (c) 1977 BY C DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED C ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY C OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY C TRANSFERRED. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE C AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT C CORPORATION. C C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. C C C C C C C C C ++++++++++++++++++++++++++++++++++++++++++++++++++ C + + C + CALC VERSION X01-01 + C + + C + PETER BAUM 1-SEP-77 + C + DIGITAL EQUIPMENT CORPORATION + C + 146 MAIN STREET + C + MAYNARD, MASSACHUSETTS 01754 + C + + C ++++++++++++++++++++++++++++++++++++++++++++++++++ C C C C ************************************************** C * * C * SUBROUTINE STRCMP(NAME,LENGTH,RETCD) * C * * C ************************************************** C C C STRCMP LOOKS PAST BLANKS FOR THE NAME HELD BY NAME(1),...,NAME(LENGTH) C THE RETURN CODE RETCD INDICATES SUCCESS OR FAILURE: C C 1=MATCH C 2=FAILURE C C UPON EXIT, COMMON VARIABLE NONBLK C IF SUCCESSFUL, POINTS TO ONE BEYOND THE LAST CHARACTER SCANNED C FOR MATCH C IF FAILURE, UNCHANGED C C C C MODIFICATION CLASSES: M2 C C C C STRCMP CALLS GETNNB TO GET THE NEXT NON-BLANK FROM LINE(80) C C STRCMP IS CALLED BY CMND C C C C C VARIABLE USE C C I2 INDEXES NAME(LENGTH). C IS HOLDS VALUE OF NONBLANK IN CASE AN ERROR OCCURS C AND IT IS NECESSARY TO RESTORE THE VALUE. C LENGTH HOLDS THE LENGTH OF VECTOR NAME. C NONBLK POINTER FOR COMMAND LINE HELD BY LINE(80). C RETCD HOLDS RETURN CODE. 1=MATCH, 2=FAILURE C C C C SUBROUTINE STRCMP(NAME,LENGTH,RETCD) INTEGER*2 LEVEL,NONBLK,LEND INTEGER*2 RETCD,VIEWSW,BASED C LOGICAL*1 LINE(80),NAME(LENGTH) LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ C COMMON /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED C C UPON ENTRANCE, NONBLK POINTS TO THE FIRST CHARACTER C IN NAME, COMPARE LOOKS PAST THIS TO THE NEXT CHARACTER C SINCE CMND HAS ALREADY IDENTIFIED THAT FIRST CHARACTER C IN THE COMMAND NAME (AFTER THE ASTERISK). IS=NONBLK CALL GETNNB(IPT,RETCD) GO TO (10,999),RETCD C ON EXIT NONBLK POINTS TO LAST CHARACTER IN NAME C C 10 DO 100 I2=1,LENGTH CALL GETNNB(IPT,RETCD) GO TO (20,999),RETCD STOP 20 20 NONBLK=IPT IF(NAME(I2).NE.LINE(NONBLK))GOTO 999 100 CONTINUE RETCD=1 RETURN C C C NO MATCH 999 RETCD=2 C IF ERROR, RESTORE VALUE OF NONBLK NONBLK=IS RETURN END