.TITLE STLOCA .IDENT /V02/ .ENABLE LC ; ; This subroutine locates the first occurrence of any one of a given ; string of ASCII characters in an ASCII string ; ; Author: V01 16-Mar-79 Mark Woolfson ; V02 28-Jan-80 Phil Stephensen-Payne ; ; Calling Sequence: ; ; This subroutine is called via the standard FORTRAN calling sequence as:- ; ; CALL STLOCA (SEASTR,SEALEN,ASCSTR,ASCLEN,POS [,STATUS]) ; or ; STATUS = STLOCA (SEASTR,SEALEN,ASCSTR,ASCLEN,POS) ; ; Where:- ; SEASTR = Address of string holded characters to be searched for ; SEALEN = Length of string holding caharcters to be searched for ; ASCSTR = Address of string to be searched ; ASCLEN = Length of string to be searched ; POS = Output position of first char found (0=none found) ; STATUS = Optional error return ; ; Errors Returned: ; ; STATUS = 0 if the operation was successful ; = -1 if a parameter error was detected ; = +1 if none of the characters could be found ; ; External References: ; ; This module calls the subroutines STFIND and PRMCHK ; ; ; STRING: .WORD 0 ;STRING VALUE TO SEARCH FOR LENGTH: .WORD 1 ;LENGTH OF SEARCH STRING = 1 DESLEN: .WORD 0 ;LENGTH OF STRING TO BE SEACHED LOCADR: .WORD 0 ;RETURN POSITION ; PARAM: .WORD 5 ;NUMBER PARAMS FOR STFIND ROUTINE .WORD STRING ; .WORD LENGTH ; DESTIN: .WORD 0 ;ADDRESS OF STRING TO BE SEARCHED .WORD DESLEN ; .WORD LOCADR ; ; STLOCA:: MOV #6.,R0 ;SET UP NUMBER OF PARAMS CALL PRMCHK ;CHECK ON PARAMETERS BCS 40$ ; If CS parameter error - exit at once MOV #-1,R0 ; Pretend there's an error BIT #1,10.(R5) ; Return parameter word-alined? BNE 40$ ; If ne no - return error MOVB @4(R5), R3 ;GET LENGTH OF SCAN STRING BIC #177400,R3 ; Clear off any sign extension BEQ 40$ ;QUIT IF NOTHING TO DO MOV 2(R5), R1 ;GET ADDR OF SCAN STRING CLR @10.(R5) ;INITIALISE FOUND POSITION TO NOT FOUND ; 10$: MOVB (R1)+, STRING ;SET UP STRING ADDR IN STFIND PARAM BLOCK MOV 6(R5), DESTIN ;SET UP DEST STRING ADDR IN STFIND PARAM BLOCK MOVB @8.(R5),DESLEN ;SET UP DEST STRING LEN IN STFIND PARAM BLOCK MOV R5, -(SP) ;SAVE R5 ON STACK MOV #PARAM, R5 ;PUT PARAM ADDR INTO R5 JSR PC, STFIND ;CALL STFIND ROUTINE MOV (SP)+, R5 ;RESTORE R5 TST LOCADR ;DID WE FIND ONE? BEQ 30$ ;...NO TST @10.(R5) ;...YES, SO HAVE WE FOUND ONE BEFORE? BEQ 20$ ; ...NO, SO MAKE THIS THE FOUND POSN CMP LOCADR, @10.(R5) ; ...YES, SO WHICH IS LOWER? BGT 30$ ; .... PRESENT ONE ; 20$: MOV LOCADR, @10.(R5) ; .... NEW ONE ; 30$: SOB R3,10$ ;TEST IF ANY MOVE CHARS TO SEARCH FOR CLR R0 ; Initialise to success TST @10.(R5) ; Did we find anything? BNE 40$ ; If ne yes - carry on INC R0 ; No - flag error ; 40$: RETURN ;QUIT .END