Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0001/strcmp.for
There is 1 other file named strcmp.for in the archive. Click here to see a list.
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