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