.MCALL	.MODULE
.MODULE	INDEX,VERSION=06,COMMENT=<INDEX/SYSLIB>,IDENT=NO,LIB=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.SBTTL	INDEX - FORTRAN CALLABLE SUBROUTINE
;
;	CALL INDEX(A,PATTRN[,I][,J])
;	J = INDEX(A,PATTRN[,I])
;
; THE STRING IN ARRAY A IS SEARCHED FOR AN OCCURENCE OF THE STRING
; IN PATTRN.  OPTIONAL ARGUMENT I SPECIFIES THE STARTING CHARACTER
; POSITION OF STRING A WHERE THE SEARCH WILL BEGIN.  IF ARGUMENT
; I IS OMITTED, THEN A IS SEARCHED BEGINNING AT THE LEFT (CHARACTER
; POSITION 1).  ARGUMENT J IS THE RESULT VARIABLE AND IS SET TO THE
; CHARACTER POSITION OF THE FIRST OCCURRENCE OF PATTRN IN A (IN A
; LEFT-TO-RIGHT SENSE).  IF PATTRN DOES NOT OCCUR IN A, A VALUE OF
; ZERO IS RETURNED IN J.
;

.PSECT	SYS$I

.GLOBL	$SYSLB

.ENABL	LSB

INDEX::	MOV	(R5)+,-(SP)	;# OF ARGS IN LOW BYTE
	MOV	(R5)+,R1	;POINTER TO A
	MOV	(R5)+,R2	;POINTER TO PATTRN
	MOV	#1,R0		;CHARACTER POSITION
	CMPB	#3,@SP		;ARGUMENT I GIVEN?
	BHI	20$		;NO
	MOV	(R5)+,R4	;POINTER TO I
	CMP	#-1,R4		;MISSING ARG?
	BEQ	20$		;YES, SKIP IT
	TST	@R4		;I > 0 ?
	BLE	FAIL		;NO
10$:	CMP	@R4,R0		;SKIPPED ENOUGH CHARS YET?
	BLOS	20$		;YES, GO DO SOME WORK
	INC	R0		;BUMP CHAR POSITION
	TSTB	(R1)+		;SKIP A BYTE IN INPUT STRING
	BNE	10$
	BR	FAIL		;REACHED END OF STRING, RETURN 0

20$:	TSTB	@R2		;FIRST NULL ?
	BEQ	FAIL		;YES
	MOV	R2,R4		;SAVE POINTER TO PATTRN
	MOV	R1,R3		;SAVE SEARCH STARTING POINT
30$:	TSTB	@R2		;AT END OF PATTRN?
	BEQ	SUCCES		;YES, SIGNAL SUCCESS
	TSTB	@R1		;AT END OF STRING?
	BEQ	FAIL		;YES, SIGNAL FAILURE
	CMPB	(R1)+,(R2)+	;COMPARE TWO BYTES
	BEQ	30$		;LOOP
	MOV	R4,R2		;RE-POINT TO PATTRN
	INC	R0		;BUMP CHAR POSITION
	INC	R3		;BUMP SEARCH PTR
	MOV	R3,R1
	BR	30$

.DSABL	LSB
.ENABL	LSB

FAIL:	CLR	R0		;INDICATE FAILURE TO FIND PATTRN
SUCCES:	CMPB	#4,(SP)+	;ARG J GIVEN?
	BHI	10$		;NO, JUST RETURN RESULT IN R0
	CMP	#-1,@R5		;ARGUMENT MISSING?
	BEQ	10$		;= -> YES
	MOV	R0,@(R5)+	;STORE RESULT INTO J
10$:	RETURN

.END