C	STRLIB.FLX	-	STRING HANDLING ROUTINES FOR RT-11 FLECS
C
C		( MAY BE USED SEPERATELY TO PROVIDE A RUNTIME
C		  FLECS STRING HANDLING LIBRARY FOR FLECS USERS)
C
	INCLUDE	"FLX:FLXAUT.FLX"
C
C       
C***********************************************************************
C       
	SUBROUTINE CATNUM(DEST,NUMBER)
C       
C  CALL CATNUM (DEST,NUM)
C  Concatenates to the string DEST, the 5 character 
C  representation for the number NUM.
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 NUMBER,TMPSTR(4)
	BYTE 	DEST(1)
C
	DATA TMPSTR(1) /5/
C
	ENCODE (5,100,TMPSTR(2)) NUMBER
100	FORMAT (I5)
	CALL CATSTR (DEST,TMPSTR)
	RETURN
	END
C       
C***********************************************************************
C       
	SUBROUTINE CATSTR(DEST,SOURCE)
C       
C  CALL CATSTR (DEST,SOURCE)
C  Concatenates the string SOURCE to the right end of the string DEST.
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 LEN1,LEN2,LIM,PTR1,PTR2
	BYTE BLEN1(2),BLEN2(2),DEST(1),SOURCE(1)

	LEN1 = BY2INT (DEST)
	LEN2 = BY2INT (SOURCE)

	PTR1 = LEN1 + 3		!SET POINTER TO FIRST SPACE AFTER DEST
	PTR2 = 3		!BEGINNING OF SOURCE
	LIM = PTR2 +LEN2 -1
C
	WHILE (PTR2 .LE. LIM)
	DEST(PTR1) = SOURCE(PTR2)
	PTR1 = PTR1+1
	PTR2 = PTR2+1
	FIN
C				UPDATE DEST LENGTH
	LEN1 = LEN1 + LEN2
	CALL PUTINT (LEN1,DEST)
C
	RETURN
	END
C       
C***********************************************************************
C       
	SUBROUTINE CATSUB(STR1,STR2,START,LENGTH)
C       
C  CATSUB CONCATENATES A SUBSTRING OF STR2 TO THE END OF STRING STR1.
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 START,LENGTH,LEN1,LEN2,PTR1,PTR2
	BYTE      BLEN1(2),BLEN2(2),STR1(1),STR2(1)
C
C
C					MOVE STRING LENGTHS INTO LOCAL
C					BYTE ARRAYS EQUIV'D TO INTEGERS
	LEN1 = BY2INT (STR1)
	LEN2 = BY2INT (STR2)
C
	PTR1 = LEN1 + 3
	PTR2 = START + 2
	LIM = PTR2 + LENGTH - 1
C
	WHILE (PTR2 .LE. LIM)
	STR1(PTR1) = STR2(PTR2)
	PTR1 = PTR1 + 1
	PTR2 = PTR2 + 1
	FIN
C
	LEN1 = LEN1 + LENGTH
	CALL PUTINT (LEN1,STR1)
C
	RETURN
	END
C       
C***********************************************************************
C       
C
C
	INTEGER FUNCTION CHTYP(CH)
C
C
C		RETURNS:
C
C			1  FOR A-Z (UC OR LC)
C			2 FOR 0-9
C			3 FOR '-'
C			4 FOR '('
C			5 FOR ')'
C			6 FOR TAB OR BLANK
C			7 FOR ALL OTHER  CHARACTERS
C
C
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 CHTYP,CH
	BYTE  CHTARR(128)
C
C
C
	DATA CHTARR /
     1	7,7,7,7,7,7,7,7,        
     1	7,6,7,7,7,7,7,7,        
     1	7,7,7,7,7,7,7,7,        
     1	7,7,7,7,7,7,7,7,        
     1	6,7,7,7,7,7,7,7,        
     1	4,5,7,7,7,3,7,7,        
     1	2,2,2,2,2,2,2,2,        
     1	2,2,7,7,7,7,7,7,        
     1	7,1,1,1,1,1,1,1,        
     1	1,1,1,1,1,1,1,1,        
     1	1,1,1,1,1,1,1,1,        
     1	1,1,1,7,7,7,7,7,        
     1	7,1,1,1,1,1,1,1,        
     1	1,1,1,1,1,1,1,1,        
     1	1,1,1,1,1,1,1,1,        
     1	1,1,1,7,7,7,7,7   /     
C
C
	CHTYP = CHTARR (CH+1)
C
C
C
C
C
C	
	RETURN
	END
C
C       
C***********************************************************************
C       
	SUBROUTINE CPYSTR(STR1,STR2)
C       
C  CPYSTR SETS STRING STR1 EQUAL TO A COPY OF STRING STR2
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 LEN2,PTR,LIM
	BYTE BLEN2(2),STR1(1),STR2(1)
C
	LEN2 = BY2INT (STR2)
C
	PTR = 1
	LIM = LEN2 + 2
C
	WHILE (PTR .LE. LIM)
	STR1(PTR) = STR2(PTR)
	PTR = PTR + 1
	FIN
C
	RETURN
	END
C       
C***********************************************************************
C       
	SUBROUTINE CPYSUB(STR1,STR2,START,LENGTH)
C       
C  CPYSUB SETS STRING STR1 EQUAL TO A COPY OF A SUBSTRING OF STR2
C  OF LENGTH LENGTH STARTING AT START
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER START,LENGTH,LEN,PTR1,PTR2,LIM
	BYTE STR1(1),STR2(1),BLEN(2)
C
	LEN = LENGTH
	CALL PUTINT (LEN,STR1)
C
	PTR1 = 3
	PTR2 = START + 2
	LIM = PTR2 + LENGTH - 1
C
	WHILE (PTR2 .LE. LIM)
	STR1(PTR1) = STR2(PTR2)
	PTR1 = PTR1 +1
	PTR2 = PTR2 + 1
	FIN
C
	RETURN
	END
C
C***********************************************************************
C
	FUNCTION CHUC (CH)
C
C	CHUC SHIFTS CHARACTER CH TO UPPER CASE IF CH IS LOWER CASE
C
	IMPLICIT INTEGER (A-Z)
	
	DATA CHAA,CHZZ / "141, "172/
	DATA MASK /"137/    !CONVERTS LC TO UC

	WHEN ((CH.GE.CHAA) .AND. (CH.LE.CHZZ)) CHUC = (CH .AND. MASK)
	ELSE                                   CHUC = (CH)

	RETURN
	END
C       
C***********************************************************************
	SUBROUTINE STRUC (BSTRNG)
C
C	STRUC shifts the characters in string BSTRNG to upper case
C
	INTEGER*2 BY2INT,CH,LEN
	BYTE BSTRNG(1)
	INTEGER*2 CHAA,CHZZ,MASK

	DATA CHAA,CHZZ / "141,"172 /
	DATA MASK /"137/
	LEN = BY2INT (BSTRNG)
	I = 1
	WHILE (I .LE. LEN)
	CH = BSTRNG (I+2)
	IF (CH .GE. CHAA  .AND.  CH .LE. CHZZ)
	CH = CH .AND. MASK
	BSTRNG (I+2) = CH
	FIN
	I = I + 1
	FIN
	RETURN
	END
	SUBROUTINE PUTNUM (BSTRNG,NUMBER)
C       
C  PUTNUM PLACES A 5 DIGIT NUMBER AT THE BEGINNING OF STRING BSTRNG
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 ILEN,NUMBER
	BYTE      BLEN(2),BSTRNG(1)
C
C
	ENCODE (6,100,BSTRNG(3)) NUMBER
100	FORMAT (I5)
C
	RETURN
	END
C       
C***********************************************************************
C       
	LOGICAL FUNCTION STREQ (STR1,STR2)
C       
C  STREQ IS A LOGICAL FUNCTION WHICH INDICATES WHETHER OR NOT
C  STRING STR1 IS EQUAL TO STRING STR2.
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 LEN1,LEN2,I
	BYTE      BLEN1(2),BLEN2(2),STR1(1),STR2(1)
	LOGICAL*4 STREQ
C
	LEN1 = BY2INT (STR1)
	LEN2 = BY2INT (STR2)
C       
	CONDITIONAL
	(LEN1 .NE. LEN2) STREQ = .FALSE.
	(LEN1 .LE. 0)   STREQ = .TRUE.
	(OTHERWISE)
	STREQ=.TRUE.
	L=LEN1+2
	I=3
	WHILE ((I.LE.L) .AND. STREQ)
	CHUC1= STR1(I)
	CHUC2= STR2(I)
	IF  (CHUC(CHUC1) .NE. CHUC(CHUC2))
	STREQ=.FALSE.
	FIN
	I=I+1
	FIN
	FIN
	FIN
	RETURN
	END
C       
C***********************************************************************
C       
	LOGICAL FUNCTION STRLT(STR1,STR2)
C       
C  STRLT IS A LOGICAL FUNCTION WHICH INDICATES WHETHER OR NOT
C  STRING STR1 IS LEXICOGRAPHICALLY LESS THAN STRING STR2.
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 LEN1,LEN2,PTR,LIMIT
	BYTE      BLEN1(2),BLEN2(2),STR1(1),STR2(1)
	LOGICAL*4 STRLT
C
	LEN1 = BY2INT (STR1)
	LEN2 = BY2INT (STR2)
	LIM = MIN0 (LEN1,LEN2)
	PTR = 2
C
	REPEAT UNTIL ((PTR .GT. LIM) .OR. (CHUC(CH1) .NE. CHUC(CH2)))
	PTR = PTR +1
	CH1 = STR1 (PTR)
	CH2 = STR2 (PTR)
	FIN
C
	CONDITIONAL
	(I .GT. LIM)
	IF (LEN1 .GE. LEN2) STRLT = .FALSE.
	FIN
	(CHUC(CH1) .GE. CHUC(CH2)) STRLT = .FALSE.
	(OTHERWISE) STRLT = .TRUE.
	FIN
C
	RETURN
	END
C       
C***********************************************************************
C       
	INTEGER FUNCTION NEWNO(N)
C       
C  NEWNO IS A SEQUENTIAL NUMBER GENERATOR.
C       
	INTEGER N
	WHEN (N.NE.0) NEWNO=N
	ELSE NEWNO=NEWNO-1
	RETURN
C       
C       
	END
C
C************************************************************
C
	SUBROUTINE GETCH (WORD,POS,CH)
C
C  GETCH RETURNS THE CHARACTER IN POSITION POS IN CH
C
	INTEGER*2 POS,CH
	BYTE      WORD(2)
C
	CH = 0
	CH = WORD (POS)
	RETURN
	END
C
C************************************************************
C
	SUBROUTINE PUTCH (WORD,POS,CH)
C
C  PUTCH PUTS CHARACTER CH IN BYTE POS OF WORD
C
	INTEGER*2 WORD,POS,CH
C
	WHEN (POS .EQ. 1) WORD = (WORD .AND. 32512) .OR. CH
	ELSE              WORD = (WORD .AND. 127) .OR. (CH * 256)
C
	RETURN
	END
	FUNCTION FLNDEX (ISTRNG,IPATRN)
C
C	RETURN POSITION OF IPATRN IN ISTRNG
C	DESIGNED TO WORK THE SAME AS "INDEX" BY L.BRUNS (DEC-10)
C

	IMPLICIT INTEGER (A-Z)

C	INCLUDE "FLX:FLXSY3.FLX"
$NOLIST
	INCLUDE "FLX:FLXSY3.FLX"
$LIST

	INTEGER*2 FLNDEX,SLEN,PLEN
	INTEGER*2 ISTRNG(1),IPATRN(1)
	BYTE      BSTRNG(100),BPATRN(100)

	EQUIVALENCE (BSTRNG(1),SSCRAT(1))
	EQUIVALENCE (BPATRN(1),SSCRAT(101))
	CALL CPYSTR (BSTRNG,ISTRNG)
	CALL CPYSTR (BPATRN,IPATRN)
	
	CALL STRUC (BSTRNG)
	CALL STRUC (BPATRN)

	SLEN = ISTRNG(1)
	PLEN = IPATRN(1)

	BSTRNG(SLEN+3) =0
	BPATRN(PLEN+3) = 0

	FLNDEX = INDEX (BSTRNG(3),BPATRN(3))

	RETURN
	END
	FUNCTION BY2INT (BARRAY)
C
C	TO RETURN VALUE IN 1ST 2 BYTES OF AN ARRAY AS INTEGER
C
	INTEGER*2 BY2INT,BARRAY

	BY2INT = BARRAY
	RETURN
	END

	SUBROUTINE PUTINT (INTG,BARRAY)
C
C	TO PUT INTEGER INTO BYTE ARRAY
C
	INTEGER*2 INTG,BARRAY(1)

	BARRAY(1) = INTG
	RETURN
	END
C       
C***********************************************************************
C       
	INTEGER FUNCTION HASH(A,PRIME)
C       
C  HASH COMPUTES AN INTEGER IN THE RANGE 0 TO PRIME-1 BY HASHING
C  THE STRING A INCLUDING ITS LENGTH.
C  HASH REDUCED MOD PRIME BEFORE SUMMING TO AVOID INTEGER OVERFLOW.
C       
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 PRIME
	BYTE A(1)
C       
	L=BY2INT(A(1)) + 1
	HASH=L
	I=3
	WHILE(I.LE.L)
	ILET = A(I)
	ILET = CHUC(ILET)
	HASH = HASH + ILET - (ILET/PRIME) * PRIME
	I=I+1
	FIN
	IF(HASH.LT.0) HASH=-HASH
	HASH=HASH-(HASH/PRIME)*PRIME
	RETURN
	END