Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/inspec.mac
There are 7 other files named inspec.mac in the archive. Click here to see a list.
; UPD ID= 1163 on 5/24/83 at 10:48 AM by NIXON                          
TITLE	INSPEC FOR COBOTS - COBOL INSPECT VERB
SUBTTL	D.A.WRIGHT

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE ITEMS OF SUCH LICENSE.

COPYRIGHT (C) 1978, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	LBLPRM		;DEFINE PARAMETERS.
IFN TOPS20,<	SEARCH	MACSYM,MONSYM>
IFE TOPS20,<	SEARCH	MACTEN,UUOSYM>
	%%LBLP==:%%LBLP
	EXTERN	EASTB.		;MAKE SURE EASTBL IS LOADED
	EXTERN	ALP.69,ALP.76,ALP.79,ALP.96,ALP.97

;REVISION HISTORY:

;[646] 25-AUG-80  DAW	INSPECT..REPLACING 1-CHAR-ITEM DIDN'T WORK
;[546]  8-DEC-78  DAW	FIX SMASHING OF AC WHEN REPLACING
;
;******** RELEASE COBOL-74 V12, 1-DEC-78 *********
;
;	3/1/78	DAW	REWRITE OF DMN'S ORIGINAL INSPECT MODULE
;			TO CORRECT A MAJOR DESIGN FLAW

	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file
	SALL

	ENTRY	INSP.
	OPDEF	PJRST	[JRST]
	OPDEF	NOP	[TRN]		;A FAST NO-OP

;THIS ROUTINE PERFORMS THOSE ACTIONS NECESSARY FOR THE IMPLEMENTATION
;	OF THE COBOL "INSPECT" STATEMENT.

;THE ROUTINE IS CALLED BY A "PUSHJ PP,INSP." WITH THE ADDRESS IN "PA"
;	OF AN ARGUMENT LIST.
;ALSO, AC12 CONTAINS A MODIFIED BYTE POINTER TO THE INSPECTED ITEM.

; THERE ARE TWO TYPES OF ARGUMENT LISTS -- ONE FOR A "TALLYING"
;OPERATION AND ONE FOR A "REPLACING" OPERATION.
; THE FIRST WORD OF EACH ARGUMENT LIST CONTAINS:
;
; LH = -NUMBER OF ARGUMENTS TO FOLLOW
; RH = ARGUMENT LIST FLAGS:
;	1B35=0 IF TALLYING
;	    =1 IF REPLACING
;	1B34=1 IF INSPECTING A SIGNED NUMERIC ITEM
;	1B33=1 IF ITEM HAS A LEADING SIGN
;	1B32=1 IF ITEM HAS A SEPARATE SIGN
;	3B31=0 IF INSPECTED ITEM IS SIXBIT
;	    =1 IF INSPECTED ITEM IS ASCII
;	    =2 IF INSPECTED ITEM IS EBCDIC
;	(BYTE SIZE INDICATOR FOR INSPECTED STRING)
;	1B28=1 IF CONVERTING

%REPLF==1B35
%SIGND==1B34
%LEDSN==1B33
%SEPSN==1B32
%CONVR==1B28

BSI.I:	POINT 3,(PA),31		;BYTE SIZE INDICATOR FOR INSPECTED STRING
BSI%SX==0		;SIXBIT
BSI%AS==1		;ASCII
BSI%EB==2		;EBCDIC
;	EACH ARGUMENT IS TWO WORDS.

; FOR "TALLYING":
;ARG.N:	LOC.1 ,, LOC.2
;	LOC.3 ,, TALLY.LOC

;LOC.1=	0 IF NO "AFTER" OR "BEFORE" PHRASE
;	ELSE POINTS TO THE "AFTER" OR "BEFORE" SEARCH STRING BYTE PTR.
;	IF BOTH THE "BEFORE" AND "AFTER" PHRASES ARE USED, THIS POINTS
;	TO THE FIRST SEARCH STRING SPECIFIED, AND THE NEXT WORD AFTER
;	IS THE BYTE POINTER TO THE SECOND STRING.
; EXAMPLE OF POINTER WHEN A BEFORE AND AFTER PHRASE IS USED:
;	INSPECT identifier ... BEFORE identifier, AFTER identifier
;
;	LOC.1: ---------------------------------------------------------\
;	.								|
;	.								|
;	.								|
;		BYTE POINTER TO SEARCH STRING FOR BEFORE IDENTIFIER <---/
;		BYTE POINTER TO SEARCH STRING FOR AFTER IDENTIFIER

;LOC.2 = ADDRESS OF A 2- (OR 3-) WORD %TEMP BLOCK:
;
; %TEMP: OPERAND FLAGS ,, "BEFORE" CHARACTER POSITION
;		Z	,, "AFTER" CHARACTER POSITION
; THE THIRD WORD IS ONLY PRESENT IF THIS ARGUMENT IS FOR A "LEADING"
;SEARCH. IF A MATCH HAS ALREADY OCCURED, IT HOLDS THE NEXT CHARACTER
;POSITION OF THE INSPECTED STRING.

; THE OPERAND FLAGS (DESCRIBED BELOW) ARE SETUP BY THE
;"SETUP OPERAND FLAGS" CODE.
; THE "BEFORE" AND "AFTER" CHARACTER POSITIONS ARE SETUP
;BY THIS ROUTINE, BEFORE ANY INSPECTION IS DONE.

;LOC.3 = ADDRESS OF THE BYTE PTR TO THE SEARCH STRING
;	(OR 0 IF "CHARACTERS" IS THE SEARCH ARGUMENT)
;	(OR CHAR VALUE IF ONE LITERAL CHARACTER).

;TALLY.LOC = ADDRESS OF A 1-WORD ITEM THAT IS INCREMENTED WITH
;	AN "AOS" EACH TIME A MATCHING OCCURANCE IS FOUND.
; FOR THE "REPLACING" ARGUMENT LIST, THE FORMAT OF EACH ARGUMENT IS:

;ARG.N:	LOC.1 ,, LOC.2
;	LOC.3 ,, LOC.4

;LOC.1 = SAME AS LOC.1 IN "TALLYING" ARG LIST

;LOC.2 = SAME AS LOC.2 IN "TALLYING" ARG LIST

;LOC.3 = SAME AS LOC.3 IN "TALLYING" ARG LIST

;LOC.4 = ADDRESS OF BYTE PTR TO "REPLACING" STRING
;	(OR CHAR VALUE IF 1 CHARACTER LITERAL)



;	NOTE
;	----
;
;  EACH BYTE POINTER TO A STRING IS THE MODIFIED BYTE POINTER THAT
;ALSO CONTAINS THE LENGTH OF THE STRING.

;
;  THE OPERAND FLAGS ARE:
;
;1B0 = 1 IF THIS ARG CAN NEVER AGAIN BE REFERENCED
;1B1 = 1 IF "LEADING" SEARCH
;1B2 = 1 IF "FIRST" SEARCH
;1B3 = NOT USED
;3B5 = BYTE SIZE INDICATOR FOR LOC.1
;3B7 = BYTE SIZE INDICATOR FOR LOC.3
;3B9 = BYTE SIZE INDICATOR FOR LOC.4
;1B10 = 1 IF LOC.3 IS A CHARACTER VALUE
;1B11 = 1 IF LOC.4 IS A CHARACTER VALUE
;1B12 = 1 IF %TEMP+2 = "LEADING" CHAR POSITION (1 LEADING MATCHED)
;1B13 = 1 BOTH "BEFORE" AND "AFTER" SPECIFIED
;     = 0 NOT BOTH SPECIFIED
;1B14 = 1 IF FIRST ARGUMENT WAS "AFTER" OR ONLY "AFTER" SPECIFIED
;     = 0 IF FIRST ARGUMENT WAS "BEFORE" OR NOT "AFTER" SPECIFIED

; USE THE BYTE PTRS BELOW TO GET OPERAND FLAGS, WHEN T1 IS LOADED
; UP WITH RH= ADDRESS OF %TEMP BLOCK.


OF%NAR==1B0
OF%LDS==1B1
OF%L3C==(1B10)
OF%L4C==(1B11)
OF%IBA==(1B13)
OF%IAF==(1B14)
BSI.L1:	POINT 2,(T1),5		;BSI FOR LOC.1
BSI.L3:	POINT 2,(T1),7		;BSI FOR LOC.3
BSI.L4:	POINT 2,(T1),9		;BSI FOR LOC.4
;DEFINITIONS

;ACS USED IN THIS ROUTINE

CV=0		;CONVERSION INSTRUCTION
T1=1		;TEMP.
T2=2
T3=3
T4=4
T5=5
T6=6

;INSPECTED STRING POINTERS
IPI=4		;INITIAL BYTE PTR TO INSPECT STRING
CPI=5		;CURRENT POINTER
CCI=6		;CURRENT CHARACTER COUNTER
		; LH= -# OF CHARS LEFT TO SCAN
		; RH = CHARS SCANNED ALREADY

;STRING "A" POINTERS
IPA=7		;INITIAL
CPA=10
CCA=11

AC12=12		;PASSED PTR TO INSPECT STRING

;*** WARNING - TO CHANGE THE VALUE OF "C" HERE REQUIRES CHANGING EASTBL ***
C=12		; WHICH IS PUSH'D AND USED TO HOLD CHARACTERS IN INSPECTED
		;STRING.
;SOME MORE ACS TO USE
P1=13
P2=14
P3=15

PA=16		;RH= ADDR OF ARG. LIST
FLG=PA		;LH= FLAGS
PP=17		;PUSHDOWN PTR.

;OFFSETS TO THE STRING INFO BLOCKS DEFINED ABOVE
IPO==0		;INITIAL PTR OFFSET
CPO==1		;CURRENT PTR OFFSET
CCO==2		;CURRENT COUNTER OFFSET

;FLAGS
	FL.REP==(1B0)	;"REPLACING", NOT "TALLYING"
	FL.SGN==(1B1)	;INSPECTED STRING HAS AN IMBEDDED SIGN
	FL.TRS==(1B2)	; (YUP, TRAILING IMBEDDED SIGN)
	FL.L3C==(1B3)	;LOC.3 IS CHARACTER VALUE
	FL.L4C==(1B4)	;LOC.4 IS CHARACTER VALUE
	FL.CHR==(1B5)	;LOOKING FOR "CHARACTERS"
	FL.LED==(1B6)	;"LEADING"
	FL.FST==(1B7)	;"FIRST"
	FL.1AG==(1B8)	;ONLY 1 ARGUMENT (SIMPLE INSPECT - NORMAL CASE)
	FL.OPM==(1B9)	;OVERPUNCH A "-" WHEN DONE INSPECTING
	FL.NOP==(1B10)	;CONVERSION INSTRUCTION IS A NOOP
SUBTTL	Start here

INSP.:	PUSH	PP,AC12		;SAVE AC12 SO WE CAN USE IT TO HOLD CHARS.
	MOVE	T1,AC12		;GET MODIFIED BYTE PTR TO INSPECTED STRING
	LDB	T3,BSI.I	;GET BYTE SIZE INDICATOR
	HLRO	T2,(PA)		;GET -ARGS
	AOJN	T2,.+2		; JUMP IF NOT 1
	TLO	FLG,FL.1AG	;JUST 1 ARG TO WORRY ABOUT!
	HRRZ	T2,(PA)		;T2:= ARGUMENT STRING FLAGS
	TRNE	T2,%REPLF	; REPLACING?
	TLO	FLG,FL.REP	; YES, REMEMBER TYPE OF INSPECT
	TRNN	T2,%SIGND	;SKIP IF ITEM IS SIGNED NUMERIC
	 JRST	INSP.0		;NO, EASY
	TRNN	T2,%SEPSN	;SEPARATE?
	 JRST	IMBDSN		; IMBEDDED SIGN
	TRNN	T2,%LEDSN	;SKIP IF LEADING SEPARATE
	 JRST	INSP.0		;NO, ALL OK

;LEADING SEPARATE SIGN IN INSPECTED ITEM. ADJUST BYTE PTR TO SKIP OVER IT.
;NOTE: TRAILING SEPARATE SIGN IS HANDLED BY THE COMPILER.

	ADDI	T3,6		;GET A REAL BYTE SIZE IN T3
	CAIN	T3,^D8
	MOVEI	T3,^D9
	LDB	T2,[POINT 12,T1,17] ;GET LENGTH OF STRING
	TLZ	T1,7777		;MAKE T1 A REAL BYTE PTR
	DPB	T3,[POINT 6,T1,11]
	IBP	T1		;SKIP THE LEADING SIGN CHARACTER
	SOJ	T2,		;MAKE NEW BYTE PTR
	DPB	T2,[POINT 12,T1,17]
	LDB	T3,BSI.I	;REGET BYTE SIZE INDICATOR

INSP.0:	MOVEI	T2,IPI		;NOW SETUP STRING INFO BLOCK FOR
				; INSPECTED ITEM
	PUSHJ	PP,SETSTR
SUBTTL	Setup BEFORE/AFTER limits

; SCAN ARGS FOR BEFORE/AFTER SEARCH STRINGS
; IF FOUND, DO SETUP

INSP.1:	HLLE	P1,(PA)		;-# ARGS
	HRRI	P1,1(PA)	; POINTS TO 1ST 2-WD ARG BLOCK
CHKBA:	HLRZ	P2,(P1)		;GET LOC.1
	JUMPE	P2,DONBA	; NO BEFORE/AFTER STRING
	HRRZ	T1,(P1)		;T1:= %TEMP BLOCK LOC
	LDB	T3,BSI.L1	;GET BSI FOR LOC.1 (USES T1)
	LDB	T1,BSI.I	; GET T1= BSI OF INSPECT STRING
				; TO GET CONVERSION INSTRUCTION IN CV
	XCT	TT.BA(T1)	;FETCH CONVERSION INSTRUCTION INTO CV
	CAMN	CV,[NOP]	;SEE IF CONVERSION INSTRUCTION IS A NOOP
	TLO	FLG,FL.NOP	;YES, SET FLAG
	MOVE	T1,(P2)		; GET T1= MODIFIED BYTE PTR TO B/A STRING
	MOVEI	T2,IPA		;SETUP STRING "A"
	PUSHJ	PP,SETSTR

	HRRZ	P2,(P1)		;SEE IF "BEFORE" OR "AFTER" WE WANT
	MOVE	T1,(P2)		;LH (T1)= OPERAND FLAGS

	PUSH	PP,CCA
	PUSH	PP,CCI
	PUSH	PP,CPI

	TLNE	T1,OF%IAF	;"AFTER"?
	 PUSHJ	PP,YESAFT	; YES
	TLNN	T1,OF%IAF	;"BEFORE"?
	 PUSHJ	PP,YESBEF	; YES
	HRRZ	P2,(P1)		;REGET OPERAND FLAGS
	MOVE	T1,(P2)

	POP	PP,CPI
	POP	PP,CCI
	POP	PP,CCA

	TLNN	T1,OF%IBA	;"BEFORE" AND "AFTER"
	 JRST	DONBA		; NO
; INSPECT ID-1 ... BEFORE INITIAL XXX AFTER INITIAL YYY OR
; INSPECT ID-1 ... AFTER INITIAL XXX BEFORE INITIAL YYY.
; THIS ROUTINE ASSUMES THAT THE FIRST ARGUMENT HAS BEEN DONE

	HRRZ	T1,(P1)		;T1 = %TEMP BLOCK
	LDB	T3,BSI.L1
	HLRZ	P2,(P1)		;GET LOC.1
	MOVE	T1,(P2)		;GET BYTE POINTER
	AOS	T1		;GET NEXT ADDRESS
	MOVEI	T2,IPA
	PUSHJ	PP,SETSTR	;SETUP BYTE POINTER TO SECOND STRING

	HRRZ	P2,(P1)
	MOVE	T1,(P2)
	TLNE	T1,OF%IAF	;AFTER DONE ?
	JRST	YESBA1		;YES
	PUSH	PP,CCA		;NO, DO AFTER
	PUSH	PP,CCI
	PUSH	PP,CPI
	PUSHJ	PP,YESAFT
	POP	PP,CPI
	POP	PP,CCI
	POP	PP,CCA
	JRST	DONBA

YESBA1:	PUSHJ	PP,YESBEF	;YES, DO BEFORE
	JRST	DONBA
; INSPECT ID-1 ... BEFORE INITIAL XXX.
; NOW THE "BEFORE" CHARACTER POSITION WILL BE SET TO 0, THE "AFTER"
;CHARACTER POSITION TO THE CHARACTER POSITION AT THE INITIAL OCCURANCE
;OF THE "BEFORE" STRING. IF THERE ARE NO OCCURANCES
;OF THE SEARCH STRING IN THE INSPECTED ITEM, THE "AFTER" CHAR POSITION
;WILL BE SET TO THE LENGTH OF THE STRING.


YESBEF:	MOVE	T1,(P2)		;GET OPERAND FLAGS
	TLNN	T1,OF%IBA	;BOTH "BEFORE" AND "AFTER" SPECIFIED ?
	HLLZS	(P2)		;NO, SET "BEFORE" CHAR POSITION TO 0
	ILDB	T1,CPA		;GET CHAR FROM SEARCH STRING
	TLNN	FLG,FL.NOP	;SKIP IF CONVERSION INSTRUCTION IS A NO-OP
				; (NORMAL CASE)
	 JRST	SEARB		;NO, GO THRU PAINS

;FAST LOOP LOOKING FOR FIRST CHARACTER
SEARB0:	ILDB	C,CPI		;GET CHAR FROM INSPECT STRING
	CAIN	C,(T1)		; MATCH?
	 JRST	MATBF		;YES
	AOBJN	CCI,SEARB0
	JRST	NOMTB		;NO MATCH AT ALL

SEARB:	ILDB	C,CPI		;GET CHAR FROM INSPECT STRING
	XCT	CV		;CONVERT
	CAIN	C,(T1)		; MATCH?
	 JRST	MATBF		;YES
	LDB	T1,CPA		;REGET SEARCH STRING CHAR INCASE CONVERSION
				; CHANGES IT
NOMTB1:	AOBJN	CCI,SEARB	;LOOP
;NO MATCH AT ALL.
NOMTB:	HRRZM	CCI,1(P2)	;SET "AFTER" CHAR COUNT TO LENGTH OF STRING
	POPJ	PP,		;DONE FOR THIS ARG.

;MATCHED FIRST CHAR OF SEARCH STRING
MATBF:	MOVE	P3,CCI		;SAVE CURRENT COUNTER TO INSPECTED STRING
				; INCASE THIS IS A MATCH
	MOVE	T3,CPI		;SAVE CURRENT POINTER TO INSPECTED STRING
				;  INCASE IT ISN'T
MATBF1:	AOBJP	CCA,MATBF2	;JUMP IF COMPLETE MATCH
	AOBJP	CCI,NOMTB	; NO, JUMP IF INSPECT STRING RAN OUT
	ILDB	T1,CPA
	ILDB	C,CPI		;TRY ANOTHER CHARACTER
	XCT	CV		;CONVERT
	CAIN	C,(T1)
	JRST	MATBF1
;STOPPED MATCHING
	MOVE	CPI,T3		;RESTORE CURRENT POINTER
	MOVE	CCI,P3		;AND CURRENT COUNTER
	MOVE	CPA,IPA		; START AT BEGINNING OF SEARCH STRING AGAIN
;RESET CCA
	HLRE	T3,CCA
	SUBI	T3,(CCA)
	HRLZ	CCA,T3
	ILDB	T1,CPA		;START AGAIN
	JRST	NOMTB1

;COMPLETE MATCH
MATBF2:	TRNN	P3,-1		;IF NO CHARACTERS ARE BEFORE THIS STRING,
	 JRST	NOMTA		; THIS ARG IS NEVER ELIGIBLE
	HRRZM	P3,1(P2)	;SET "AFTER" CHARACTER COUNT
	POPJ	PP,
;HERE FOR
;	INSPECT ID-1 ... AFTER INITIAL XXX.
; SET "AFTER" CHARACTER POSITION TO LENGTH OF STRING, SET "BEFORE"
;CHAR POSITION TO THE POSITION JUST AFTER THE OCCURANCE OF XXX,
;IF IT NEVER OCCURS SET FLAG TO INDICATE NO POSSIBLE MATCH.

YESAFT:	ILDB	T1,CPA		;GET CHAR FROM SEARCH STRING
	TLNN	FLG,FL.NOP	;SKIP IF CONVERSION INSTRUCTION IS A NO-OP
	 JRST	SEARA		;NOPE, GO THRU THE HAIRY CODE

;NORMAL CASE-- DO FAST SEARCH FOR FIRST CHARACTER
SEARA0:	ILDB	C,CPI		;GET CHAR FROM INSPECT STRING
	CAIN	C,(T1)		; FIRST CHAR MATCH?
	 JRST	MATAF		;YES, LOOK AT REST OF STRING
	AOBJN	CCI,SEARA0	; LOOP
	JRST	NOMTA		;NO MATCH

SEARA:	ILDB	C,CPI		;GET CHAR FROM INSPECT STRING
	XCT	CV		;CONVERT
	CAIN	C,(T1)		; FIRST MATCH?
	 JRST	MATAF		;YES, CHECK IT OUT
	LDB	T1,CPA		;NO, REGET SEARCH STRING CHAR INCASE
NOMTA1:	AOBJN	CCI,SEARA	; T1 WAS CHANGED; LOOP
;NO MATCH AT ALL.
NOMTA:	TLNE	FLG,FL.1AG	;IF JUST ONE ARGUMENT,
	 JRST	[POP	PP,	;GET RID OF RETURN ADDRESS, (CALLED BY PUSHJ)
		POP	PP,	;CLEAR STACK
		POP	PP,
		POP	PP,
		JRST	INSPDN]	;WE ARE DONE, SINCE THIS ONE NEVER PARTICIPATES
	MOVSI	T1,(1B0)	;SET FLAG MEANING THIS ARG NEVER PARTICIPATES
	IORM	T1,(P2)
	POPJ	PP,		;AND GO ON TO NEXT ARG

;HERE WHEN 1ST CHAR HAS MATCHED
MATAF:	MOVE	P3,CCI		;SAVE CCI AND CPI INCASE NO MATCH
	MOVE	T3,CPI
MATAF1:	AOBJP	CCA,MATAF2	;JUMP IF COMPLETE MATCH
	AOBJP	CCI,NOMTA	; JUMP IF INSPECT STRING RAN OUT (NO MATCH)
	ILDB	T1,CPA
	ILDB	C,CPI
	XCT	CV		;CONVERT
	CAIN	C,(T1)		;STILL MATCH?
	JRST	MATAF1		; YES, KEEP CHECKING
;STOPPED MATCHING
	MOVE	CPI,T3		;RESTORE CURRENT POINTERS
	MOVE	CCI,P3
	MOVE	CPA,IPA
	HLRE	T3,CCA		;RESET CCA
	SUBI	T3,(CCA)
	HRLZ	CCA,T3		;-LEN,,0
	ILDB	T1,CPA		;REGET 1ST CHAR IN SEARCH STRING
	JRST	NOMTA1		;AND SEARCH AGAIN

;COMPLETE MATCH WITH "AFTER" STRING
MATAF2:	MOVEI	T1,1(CCI)	;CHAR POSITION AT END OF OCCURANCE
	HRRM	T1,(P2)		; LOOK AT CHAR POSITIONS AFTER THIS
;IF BOTH AFTER AND BEFORE SPECIFIED DON'T TOUCH AFTER CHAR POSITION
	MOVE	T1,(P2)		;GET OPERAND FLAGS
	TLNE	T1,OF%IBA	;BOTH SPECIFIED ?
	POPJ	PP,		;YES, EXIT
	
	HLRE	T1,CCI		;GET T1= -LEN OF INSPECT STRING
	SUBI	T1,(CCI)
	MOVNM	T1,1(P2)	;STORE "AFTER" CHAR POSITION
	POPJ	PP,
; HERE WHEN WE HAVE SET THE BEFORE/AFTER LIMITS FOR ONE ARGUMENT

DONBA:	TLNE	FLG,FL.1AG	;IF JUST ONE ARG, GO DO THE SEARCHING PART
	 JRST	STARTS
	MOVE	CPI,IPI		;RESET INSPECT STRING PTRS
	HLRE	T1,CCI
	SUBI	T1,(CCI)
	HRLZ	CCI,T1
	AOJ	P1,
	AOBJN	P1,CHKBA	;LOOP FOR ALL THE ARGS
	HLLE	P1,(PA)		; SETUP P1 AGAIN
	HRRI	P1,1(PA)
;DONE SETTING UP "BEFORE" AND "AFTER" PARAMETERS - START INSPECTING
;HERE WHEN WE ARE DONE THE BEFORE/AFTER LIMIT SETTING
STARTS:	MOVE	CPI,IPI		;MAKE SURE INSPECT STRING PTRS
	TRNN	CCI,-1		; ARE INIT'D
	 JRST	STRTOK
	HLRE	T1,CCI
	SUBI	T1,(CCI)
	HRLZ	CCI,T1
STRTOK:	HRRZ	T2,(PA)
	TRNE	T2,%CONVR	;INSPECT CONVERTING ?
	 JRST	INSPC		; YES

	TLNN	FLG,FL.1AG	;MORE THAN 1 ARG?
	 JRST	STRTMA		;; MULTI-ARG (ARGH!)

SUBTTL	INSPECT with just one TALLY/REPLACE phrase

GET1IC:	PUSHJ	PP,SETAS	;SETUP 1ST ARG TO SEARCH
	SKIPA	P2,CCA		;SAVE INITIAL CCA IN P2 FOR EASE LATER
GET1ID:	AOBJP	CCI,INSPDN	;DONE IF INSPECT STRING RAN OUT
	ILDB	C,CPI		;GET CHAR FROM INSPECT STRING

	PUSHJ	PP,ELIG		;IS ARG ELIGIBLE?
	 JRST	GET1ID		;NO, GET NEXT CHAR OF INSPECT STRING
	TLNE	FLG,FL.L3C!FL.CHR	;SINGLE CHAR?
	 JRST	CHK1C		;YES
	ILDB	T1,CPA		;GET 1ST CHAR OF SEARCH STRING
	XCT	CV		;CONVERT
	CAIN	T1,(C)		;MATCH?
	 JRST	MAT11		; YA, GO FOR IT!
	TLNE	FLG,FL.LED	;"LEADING" SEARCH ?
	 JRST	INSPDN		;YES, IT FAILED FOR 1ST AND ONLY ARG, DONE
	MOVE	CCA,P2		;RESTORE CCA FROM P2
	MOVE	CPA,IPA		;RESET CPA
	JRST	GET1ID		;NO MATCH, TRY NEXT CHAR OF INSPECT STRING

;TRY TO MATCH A STRING, FIRST CHAR MATCHED
MAT11:	TLNE	FLG,FL.L4C	;ARE WE GOING TO REPLACE A SINGLE CHARACTER?
	 JRST	RPL1C		;YES, THEREFORE WE KNOW THAT THIS SEARCH
				; STRING IS ALSO 1 CHAR AND HAS MATCHED
	MOVE	P3,CCI
	MOVE	T3,CPI		;SAVE INSPECT POINTERS
MAT11A:	AOBJP	CCA,MAT11B	;JUMP IF COMPLETE MATCH
	AOBJP	CCI,INSPDN	;INSPECT STRING RAN OUT, NEVER WILL MATCH
	ILDB	T1,CPA
	ILDB	C,CPI
	XCT	CV
	CAIN	C,(T1)		;STILL MATCH?
	 JRST	MAT11A		;YES, KEEP CHECKING

;1ST CHAR MATCHED, BUT WHOLE STRING DIDN'T
	TLNE	FLG,FL.LED	;"LEADING" SEARCH?
	 JRST	INSPDN		;YES, IT FAILED FOR 1ST AND ONLY ARG, DONE
	MOVE	CCI,P3		;RESET INSPECT STRING PTRS
	MOVE	CPI,T3
	MOVE	CCA,P2		;RESET STRING "A" PTRS
	MOVE	CPA,IPA
	JRST	GET1ID		;AND GO FOR INSPECT STRING CHAR

;A SEARCH STRING MATCHED. TALLY OR REPLACE
MAT11B:	TLNE	FLG,FL.REP	;REPLACING?
	 JRST	MAT1RR		;YES

	HRRZ	T1,1(P1)
	AOS	(T1)		;TALLY
	TLNE	FLG,FL.FST	;"FIRST" SEARCH?
	 JRST	INSPDN		; YUP, FOUND IT, RETURN
	MOVE	CCA,P2
	MOVE	CPA,IPA
	JRST	GET1ID		; ELSE RESUME SEARCHING

MAT1RR:	MOVE	CPI,T3		;RESTORE INSPECT STRING PTR, BUT LEAVE CCI AS IS
	PUSHJ	PP,SETRS	;SETUP REPLACE STRING AS STRING "A"
MAT1RL:	ILDB	T1,CPA		;GET CHAR FROM REPLACE STRING
	XCT	CV		;CONVERT TO INSPECT STRING MODE
	DPB	T1,CPI		; AND STORE IN INSPECT STRING
	AOBJN	CCA,MAT1RM	;LOOP FOR ALL CHARS IN REPLACE STRING
	TLNE	FLG,FL.FST	;"FIRST" SEARCH?
	 JRST	INSPDN		;YES, RETURN NOW
	PUSHJ	PP,SETA1.	; ELSE RESET SEARCH STRING
	JRST	GET1ID		;AND RESUME SEARCHING

MAT1RM:	ILDB	T1,CPA
	XCT	CV
	IDPB	T1,CPI
	AOBJN	CCA,MAT1RM
	TLNE	FLG,FL.FST
	 JRST	INSPDN		;RETURN IF FIRST
	PUSHJ	PP,SETA1.	;ELSE RESET SEARCH STRING
	 JRST	GET1ID		;AND RESUME SEARCHING
;SEARCH STRING IS 1 CHAR OR "CHARACTERS"
CHK1C:	TLNE	FLG,FL.CHR	;SEARCHING FOR CHARS?
	 JRST	MAT1Y		;YES, GOT ONE
	MOVE	T1,IPA		; SEE IF THE CHAR MATCHES
	XCT	CV
	CAIN	T1,(C)		;MATCH
	JRST	MAT1Y		;YES!

	TLNE	FLG,FL.LED	;LEADING SEARCH?
	 JRST	INSPDN		;YES, PUNT NOW
	JRST	GET1ID		;ELSE LOOK AT NEXT CHAR

;1 CHAR MATCHED, TALLY OR REPLACE
; AT THIS POINT, "CPI" POINTS TO THE BYTE TO REPLACE
MAT1Y:	TLNE	FLG,FL.REP	;REPLACE?
	 JRST	MAT1YR		; YES

;TALLY
	HRRZ	T1,1(P1)	;FETCH TALLY LOC
	AOS	(T1)		; ADD 1 TO THE COUNTER
	TLNE	FLG,FL.FST	;"FIRST" SEARCH?
	 JRST	INSPDN		;YES, DONE
	JRST	GET1ID		; ELSE CONTINUE

;REPLACE
MAT1YR:	PUSH	PP,CV		;SAVE CV, SETRS WILL SET IT UP FOR REPLACING
	PUSH	PP,IPA		;SAVE SEARCH CHAR, IF ANY

	PUSHJ	PP,SETRS	;SETUP REPLACE STRING/CHAR AS STRING "A"
	TLNE	FLG,FL.L4C	;SINGLE CHARACTER?
	 SKIPA	T1,IPA		; YES, GET CHAR
	ILDB	T1,CPA		;GET FROM BYTE PTR
	XCT	CV		;CONVERT TO INSPECT STRING MODE
	POP	PP,IPA		;RESTORE ACS SAVED
	POP	PP,CV
REPIT:	DPB	T1,CPI		; *** REPLACE THE CHARACTER ***
	TLNE	FLG,FL.FST	;"FIRST" SEARCH?
	 JRST	INSPDN		;YES, DONE
	JRST	GET1ID		; LOOP FOR MORE CHARS

RPL1C:	HRRZ	T1,1(P1)	;GET T1= CHAR TO REPLACE FROM LOC.4
				;NOTE: NO CONVERSION NECESSARY BECAUSE
				;COMPILER HAS MADE SURE THE MODE IS RIGHT
	MOVE	CCA,P2		;[646] RESTORE CCA FROM P2
	MOVE	CPA,IPA		;[646] RESTORE CPA FROM IPA
	JRST	REPIT		;GO REPLACE CHARACTER AND DO CHECKS
SUBTTL	INSPECT with more than one argument

STRTMA:	JRST	GETIC1		;SKIP IF FIRST TIME

;HERE TO START SEARCH AT NEXT CHARACTER OF INSPECT STRING
GETICH:	AOBJP	CCI,INSPDN	;DONE IF INSPECT STRING RAN OUT
	IBP	IPI
	MOVE	CPI,IPI		;GET NEXT "INITIAL" PTR
GETIC0:	HLLE	P1,(PA)		;POINT TO FIRST ARG AGAIN
	HRRI	P1,1(PA)
GETIC1:	ILDB	C,CPI
	JRST	CHKTG1		;SKIP FUNNY BUSINESS IF 1ST ARG.

;SEE IF THIS ARG IS ELIGIBLE

CHKTAG:	MOVE	CPI,IPI		;RESET PTRS
	ILDB	C,CPI		;REGET 1ST CHAR
CHKTG1:	PUSHJ	PP,SETAS	;SETUP SEARCH STRING AS "A"
	MOVE	P2,CCA		;P2= CURRENT CCA
	PUSHJ	PP,ELIG		;IS IT ELIGIBLE NOW?
	 JRST	NOTELG		;NO, TRY NEXT ARG.
	TLNE	FLG,FL.LED	;LEADING SEARCH?
	 JRST	CHKLED		;YA, MAKE SURE WE CAN DO IT NOW

;CHECK FOR 1ST CHAR MATCHING
LEADOK:	TLNE	FLG,FL.L3C!FL.CHR ;SINGLE CHARACTER SEARCH STRING?
	 JRST	CHKM1C		;YES

	ILDB	T1,CPA		;GET 1ST CHAR OF SEARCH STRING
	XCT	CV		;CONVERT
	CAIN	T1,(C)		;MATCH?
	 JRST	MATM11		; YA, SO FAR, SO GOOD
	TLNN	FLG,FL.LED	;"LEADING" SEARCH?
	 JRST	SERFAI		;NO
LEDFAI:	HRRZ	T1,(P1)		;"LEADING" SEARCH FAILED -- MAKE
	MOVSI	T2,(1B0)	; THIS ARG INELIGIBLE BEFORE GOING ON
	IORM	T2,(T1)		;ON TO NEXT ARG.

;HERE IF SEARCH FAILED FOR THIS ARG.

SERFAI:
NOTELG:	AOJ	P1,
	AOBJN	P1,CHKTAG	;LOOP FOR ALL ARGS.

;SEARCH FAILED FOR ALL ARGS, GO ON TO NEXT INSPECT CHARACTER
	JRST	GETICH

;HERE TO CHECK "LEADING" SEARCH. TO BE ELIGIBLE, ONE OF THE FOLLOWING
; MUST BE TRUE:
;
; 1) THE STRING JUST BECAME ELIGIBLE FOR COMPARISON AT THIS CHARACTER
;	POSITION IN THE INSPECT STRING.
; 2) THE STRING MATCHED ONCE BEFORE, AND NO OTHER COMPARISON STRINGS
;	HAVE MATCHED SINCE THEN. (I.E. ANOTHER MATCH WOULD OCCUR
;	NOW IFF IT WAS CONTIGUOUS WITH THE PREVIOUS MATCH OF THIS ARG).
;
;  IF THE SEARCH IS DEEMED NOT ELIGIBLE AT THIS POINT, IT WILL NEVER
;BE ELIGIBLE IN THIS INSPECT.

CHKLED:	MOVE	T1,(P1)		;LOC.1,,LOC.2
	SKIPGE	(T1)		;NEVER ELIGIBLE?
	 JRST	SERFAI		;YEAH, FORGET IT ALREADY
	TLNN	T1,-1		;BEFORE/AFTER LIMITS?
	 TDZA	T2,T2		;NO, THEREFORE MUST BE AT POSITION 0
	HRRZ	T2,(T1)		;GET "BEFORE" CHAR POSITION
	CAIN	T2,(CCI)	; THERE NOW?
	 JRST	LEADOK		;YES, OK TO MATCH
	MOVE	T2,(T1)		;LH (T2) = OPERAND FLAGS
	TLNN	T2,(1B12)	; HAVE WE ALREADY MATCHED THIS LEADING?
	 JRST	LEDFAI		;NO, SET "NEVER ELIGIBLE"
	MOVE	T2,2(T1)	;WE DID MATCH - GET CHAR POSITION OF NEXT CHAR
	CAIN	T2,(CCI)	; THERE NOW?
	 JRST	LEADOK		;YES, OK TO MATCH
	JRST	LEDFAI		; ELSE NO LONGER ANY GOOD TO MATCH

;SINGLE CHAR SEARCH STRING
CHKM1C:	TLNE	FLG,FL.CHR	;SEARCHING FOR CHARS?
	 JRST	MAT1MY		;YES, GOT ONE
	MOVE	T1,IPA		; SEE IF CHAR MATCHES
	XCT	CV
	CAIN	T1,(C)
	JRST	MAT1MY		;MATCHED

	TLNE	FLG,FL.LED	;LEADING?
	 JRST	LEDFAI		;YES
	JRST	SERFAI		;NO MATCH FOR THIS ARG.

;1 CHAR MATCHED, TALLY OR REPLACE

MAT1MY:	TLNE	FLG,FL.LED
	 JRST	[HRRZ T1,(P1)	;LOC.2
		HRRZI T2,1(CCI) ;" NEXT CHAR POSITION"
		MOVEM T2,2(T1)	;STORE IT
		MOVSI T2,(1B12) ;REMEMBER WE STORED IT
		IORM  T2,(T1)
		JRST  MAT1MZ]
MAT1MZ:	TLNE	FLG,FL.REP	;REPLACE?
	 JRST	MAT1MR		; YES

;TALLY
	HRRZ	T1,1(P1)	;FETCH TALLY LOC
	AOS	(T1)
	TLNE	FLG,FL.FST	;"FIRST"
	 JRST	MAT1NO		;YES, SET "DON'T BE ELIGIBLE" AND CONTINUE
	JRST	GETICH		;GO GET NEXT CHAR

;REPLACE
MAT1MR:	PUSH	PP,CV		;SAVE CV, SETRS WILL SET IT UP FOR REPLACING
	PUSH	PP,IPA		; SAVE SEARCH CHAR, IF ANY

	PUSHJ	PP,SETRS	;SETUP REPLACING STRING/CHAR AS STRING "A"
	TLNE	FLG,FL.L4C	;SINGLE CHAR?
	 SKIPA	T1,IPA		; YES, GET CHAR
	ILDB	T1,CPA		;GET FROM BYTE PTR
	XCT	CV		;CONVERT TO INSPECT STRING MODE
	POP	PP,IPA		;RESTORE SAVED ACS
	POP	PP,CV
REPM1T:	DPB	T1,CPI		; *** REPLACE THE CHARACTER ***
	TLNN	FLG,FL.FST	;"FIRST" SEARCH?
	JRST	GETICH		;NO, BACK TO FIRST OPERAND, NEXT CHARACTER

;SET "DON'T BE ELIGIBLE" FLAG FOR THIS ARG. IT WILL NEVER BE CONSIDERED AGAIN
MAT1NO:	HRRZ	T1,(P1)		;T1 POINTS TO %TEMP BLOCK
	MOVSI	T2,(1B0)
	IORM	T2,(T1)		;SET FLAG
	JRST	GETICH		; THEN GO BACK TO FIRST OPERAND, NEXT CHARACTER

RPLM1C:	TLNE	FLG,FL.LED	;"LEADING" SEARCH?
	 JRST	[MOVE T1,(P1)	; STORE CHAR POSITION OF THE MATCH
		HRRZI T2,1(CCI)
		MOVEM T2,2(T1)
		MOVSI T2,(1B12)
		IORM T2,(T1)
		JRST .+1]
	HRRZ	T1,1(P1)	;GET CHAR VALUE FROM LOC.4
	JRST	REPM1T		; REPLACE SEARCH CHAR WITH IT, DO CHECKS

;HERE IF FIRST CHAR MATCHED FOR A SEARCH STRING

MATM11:	TLNE	FLG,FL.L4C	;HAVE A REPLACING STRING OF 1 CHAR?
	 JRST	RPLM1C		;YES, SEARCH STRING MATCHED, GO REPLACE IT
	MOVE	P3,CCI
	MOVE	T3,CPI		;SAVE INSPECT POINTERS
MATM1A:	AOBJP	CCA,MATM1B	;JUMP IF COMPLETE MATCH
	AOBJP	CCI,MATNMM	;INSPECT STRING RAN OUT, NEVER WILL MATCH
	ILDB	T1,CPA
	ILDB	C,CPI
	XCT	CV
	CAIN	C,(T1)		;STILL MATCH?
	 JRST	MATM1A		;YA, CONTINUE

;1ST CHAR MATCHED, BUT WHOLE STRING DIDN'T
	MOVE	CCI,P3		;RESET INSPECT STRING POINTERS
	MOVE	CPI,T3
	TLNE	FLG,FL.LED
	 JRST	LEDFAI
	JRST	SERFAI		;GO ON TO NEXT SEARCH STRING

MATNMM:	HRRZ	T1,(P1)		;SET "NO LONGER ELIGIBLE" FLAG
	MOVSI	T2,(1B0)
	IORM	T2,(T1)
	MOVE	CCI,P3		;RESTORE POINTERS TO INSPECTED STRING
	MOVE	CPI,T3
	JRST	SERFAI

;A SEARCH STRING MATCHED. TALLY OR REPLACE.
MATM1B:	TLNE	FLG,FL.LED	;"LEADING" MATCH?
	 JRST	[HRRZ T1,(P1)
		HRRZI T2,1(CCI) ; STORE CHAR POSITION OF NEXT CHAR
		MOVEM T2,2(T1)
		MOVSI T2,(1B12)
		IORM T2,(T1)
		JRST .+1]
	TLNE	FLG,FL.REP	;REPLACE?
	 JRST	MATM1R		;YES

	HRRZ	T1,1(P1)
	AOS	(T1)		;TALLY
	TLNE	FLG,FL.FST	;FOUND FIRST?
	 JRST	MAT2NO		;YES, SET NO LONGER ELIGIBLE
	JRST	MAT3CH		; START AGAIN AT 1ST ARG.

;REPLACE A STRING
MATM1R:	MOVE	CPI,T3
	PUSHJ	PP,SETRS	;SETUP REPLACING STRING AS "A"
MATM1L:	ILDB	T1,CPA
	XCT	CV		;CONVERT TO INSPECT STRING MODE
	DPB	T1,CPI		; AND STORE IT
	AOBJN	CCA,MATM1M
	TLNE	FLG,FL.FST
	 JRST	MAT2NO
	JRST	MAT3CH

MATM1M:	ILDB	T1,CPA
	XCT	CV
	IDPB	T1,CPI
	AOBJN	CCA,MATM1M
	TLNN	FLG,FL.FST
	JRST	MAT3CH		; "ALL" OR "LEADING" SEARCH, START AGAIN
				; AT FIRST ARG

MAT2NO:	HRRZ	T1,(P1)		;SUCCESS, BUT "FIRST", SO
	MOVSI	T2,(1B0)	;NEVER AGAIN ELIGIBLE
	IORM	T2,(T1)
MAT3CH:	AOBJP	CCI,INSPDN	;DONE IF END OF INSPECT STRING
	MOVE	IPI,CPI		; NEVER AGAIN HAVE TO LOOK AT PRECEDING CHARS
	JRST	GETIC0		;GO LOOK AT FIRST ARG AGAIN
SUBTTL	ROUTINES TO PLAY WITH ARGUMENTS

; ROUTINE TO SET UP A STRING'S PARAMETERS IN THE AC'S.
;CALL:	MOVE	T1,MODIFIED BYTE PTR
;	MOVEI	T2,ADDRESS OF 3-AC BLOCK
;	MOVEI	T3,BYTE SIZE INDICATOR (0,1, OR 2)
;	PUSHJ	PP,SETSTR
;	<RETURN HERE>

SETSTR:	SETZM	IPO(T2)		;CLEAR INITIAL BYTE PTR.
	MOVE	T3,[EXP 6,7,9](T3) ;GET T3= A REAL BYTE SIZE
	DPB	T3,[POINT 6,IPO(T2),11] ;PUT BYTE SIZE IN INITIAL PTR
	LDB	T3,[POINT 12,T1,17] ;T3= SIZE OF STRING
	MOVN	T3,T3
	HRLZM	T3,CCO(T2)	;CURRENT COUNTER IS -LEN,,0
	TLZ	T1,7777		;GET RID OF GARBAGE IN PTR
	IORM	T1,IPO(T2)	; FINISH UP BYTE PTR.
	MOVE	T3,IPO(T2)	;AND, FINALLY, STICK INITIAL PTR
	MOVEM	T3,CPO(T2)	; INTO CURRENT PTR
	POPJ	PP,
;ROUTINE TO SETUP SEARCH STRING AS STRING "A", AND SETUP FLG AND CV
; TO SEARCH.  IF THE SEARCH STRING IS A SINGLE CHARACTER, RETURN CHARACTER VALUE
;IN "IPA".

SETAS:	TLZ	FLG,FL.CHR!FL.L3C!FL.L4C!FL.LED!FL.FST
	HRRZ	T1,(P1)		;POINT TO %TEMP BLOCK
	MOVE	T1,(T1)		;LH (T1) = OPERAND FLAGS
	TLNE	T1,(1B10)	; SET APPROPRIATE FLAGS IN "FLG"
	TLO	FLG,FL.L3C
	TLNE	T1,(1B11)
	TLO	FLG,FL.L4C
	TLNE	T1,(1B1)
	TLO	FLG,FL.LED
	TLNE	T1,(1B2)
	TLO	FLG,FL.FST

; HERE TO SETUP STRING "A" AGAIN, KNOWING THE FLAGS ARE ALREADY SET UP
SETA1.:	HLRZ	T2,1(P1)	;[546] GET LOC.3
	TLNN	FLG,FL.L3C	;SKIP IF A CHAR VALUE
	 JUMPE	T2,SETCHR	;[546] JUMP IF SEARCHING FOR "CHARS"

	HRRZ	T1,(P1)
	LDB	T3,BSI.L3	;GET BSI OF LOC.3
	LDB	T1,BSI.I	;GET BSI OF INSPECT STRING
	XCT	TT.BA(T1)	; GET CONVERT INSTRUCTION FOR SEARCHING
	TLNE	FLG,FL.L3C	;IS C(P2) A CHARACTER VALUE?
	 JRST	SETAS1		;YES, GO SEE WHAT WE CAN DO
	MOVE	T1,(T2)		;[546] SETUP TO CALL SETSTR
				;[546] T1= MODIFIED BYTE PTR.
	MOVEI	T2,IPA		; USING STRING "A"
	PJRST	SETSTR

SETCHR:	TLO	FLG,FL.CHR
	POPJ	PP,
SETAS1:	MOVE	IPA,T2		;[546] PUT CHAR VALUE IN "IPA"
	POPJ	PP,
;SETRS SETS UP REPLACING STRING AS STRING "A". IF SINGLE CHARACTER,
;RETURN CHAR VALUE IN "IPA".  SETRS ALSO SETS UP "CV" FOR REPLACING.

SETRS:	HRRZ	T2,1(P1)	;[546] T2:= LOC.4
	HRRZ	T1,(P1)
	LDB	T3,BSI.L4	;GET BSI OF LOC.4
	LDB	T1,BSI.I
	XCT	TT.REP(T1)	; GET CONVERT INSTRUCTION FOR REPLACING
	TLNE	FLG,FL.L4C	;IS C(P2) A CHARACTER VALUE?
	 JRST	SETRS1		;YES
	MOVE	T1,(T2)		;[546] SETUP TO CALL SETSTR
				;[546] T1= MODIFIED BYTE PTR.
	MOVEI	T2,IPA
	PJRST	SETSTR

SETRS1:	MOVE	IPA,T2		;[546] GET CHARACTER VALUE
	POPJ	PP,
; ROUTINE TO SKIP IF THIS ARGUMENT IS ELIGIBLE FOR A COMPARISON OPERATION
;AT THIS POINT.
; CALL:	FLG/ FL.L3C!FL.L4C!FL.CHR SETUP
;	"SETAS" HAS BEEN CALLED
;	RH(CCI) = CHAR POSITION WE ARE AT IN INSPECT STRING
;	PUSHJ	PP,ELIG
;	 <RETURN HERE IF NOT ELIGIBLE>
;	<RETURN HERE IF ELIGIBLE>

ELIG:	MOVE	T1,(P1)		;T1: = LOC.1,,LOC.2
	SKIPGE	(T1)		;IS IT NEVER ELIBIGLE?
	 POPJ	PP,		; RIGHT
	TLNN	T1,-1		;HAVE TO WORRY ABOUT ELIGIBILITY?
	 JRST	YESELI		; NO, THIS ARG HAS NO AFTER/BEFORE PARAMS
	HRRZ	T2,(T1)		;T2= BEFORE CHAR POSITION
	CAILE	T2,(CCI)	; ARE WE PAST THERE?
	 POPJ	PP,		;NO--NOT ELIGIBLE
	HRRZ	T2,1(T1)	;T2= AFTER CHAR POSITION
	HRRZ	T3,CCI		;GET WHERE WE ARE NOW
	TLNN	FLG,FL.CHR!FL.L3C!FL.L4C ; IS STRING JUST 1 CHAR?
	  JRST	ELIG1		;NO, ADD LENGTH OF STRING & COMPARE
	CAMGE	T3,1(T1)	;DOES STRING FIT?
	AOSA	(PP)		;YES, RETURN OK
	 JRST	NEVELG		;NO, NEVER AGAIN ELIGIBLE
	POPJ	PP,

ELIG1:	HLRE	T2,CCA		; GET -LENGTH OF SEARCH STRING
	SUB	T3,T2		; T3= .+LENGTH OF SEARCH STRING
	CAMLE	T3,1(T1)	;DOES STRING FIT?
	 JRST	NEVELG		;NO, SET "NEVER AGAIN ELIGIBLE"
YESELI:	AOS	(PP)		;YES, RETURN OK
	POPJ	PP,		;NO

;WE'RE PAST THE "AFTER" CHARACTER POSITION. SET "NEVER AGAIN ELIGIBLE"
; FLAG TO MAKE FUTURE CALLS TO THIS ROUTINE FASTER.
NEVELG:	MOVSI	T2,(1B0)	;GET "NEVER ELIGIBLE" FLAG BIT
	IORM	T2,(T1)		; SET IT
	POPJ	PP,		; AND GIVE NO-SKIP RETURN
SUBTTL	HANDLE IMBEDDED SIGN IN INSPECTED STRING

; GET RID OF IMBEDDED SIGN, SET APPROPRIATE FLAGS SO IT
;CAN BE PUT BACK AT THE END OF THE "INSPECT".
; THE ROUTINE "NOSIGN" IS CALLED AT THE BEGINNING OF THE
;INSPECT IF THERE IS AN IMBEDDED SIGN.

;HERE FROM STARTUP CODE IF IMBEDDED SIGN

IMBDSN:	MOVEI	T2,IPI		;SETUP INSPECT STRING IN BLOCK
	PUSHJ	PP,SETSTR
	PUSHJ	PP,NOSIGN	;GET RID OF IT
	JRST	INSP.1		;AND GO CONTINUE INSPECT

NOSIGN:	LDB	T3,BSI.I	;T3:= BYTE SIZE INDICATOR
	HRRZ	T1,(PA)		;GET ARG LIST FLAGS
	TRNN	T1,%LEDSN	; IMBEDDED LEADING SIGN?
	 JRST	TRSIGN		;NO

;IMBEDDED LEADING SIGN
THSCHR:	ILDB	C,CPI		;GET THE CHAR
	PUSHJ	PP,@UNSGN(T3)	;GET AN UNSIGNED CHARACTER, SET FLAGS
	DPB	C,CPI		;PUT BACK UNSIGNED CHARACTER
NOSG1:	MOVE	CPI,IPI		;RESTORE POINTER
	POPJ	PP,		; AND RETURN

;IMBEDDED TRAILING SIGN
TRSIGN:	PUSH	PP,CCI		;-LEN,,0
	AOBJP	CCI,TRSG1	; GET TO END OF STRING
	IBP	CPI
	JRST	.-2
TRSG1:	POP	PP,CCI		;RESTORE CCI
	JRST	THSCHR

UNSGN:	EXP	G6SIGN
	EXP	G7SIGN
	EXP	G9SIGN

G6SIGN:	CVTSNM	6,C,C

CHKSNN:	TLZE	C,(1B0)		;SET IF OVERPUNCH "-"
	TLO	FLG,FL.OPM	;REMEMBER TO STORE IT BACK LATER
	POPJ	PP,

G7SIGN:	CVTSNM	7,C,C
	JRST	CHKSNN
G9SIGN:	CVTSNM	9,C,C
	JRST	CHKSNN

;RSTSGN - RESTORE IMBEDDED SIGN TO INSPECT STRING
; CALLED JUST BEFORE INSPECT RETURNS

RSTSGN:	PUSH	PP,AC12		;SAVE AC12 AGAIN
	MOVE	T1,AC12		;GET SET TO CALL SETSTR
	LDB	T3,BSI.I
	MOVEI	T2,IPI
	PUSHJ	PP,SETSTR
	HRRZ	T1,(PA)		;GET ARG LIST FLAGS
	TRNN	T1,%LEDSN	; IMBEDDED LEADING SIGN?
	 JRST	PTRASN		;PUT BACK TRAILING SIGN

PBTHSC:	ILDB	C,CPI		;GET CHARACTER TO MAKE NEGATIVE
	LDB	T3,BSI.I	;T3= MODE
	PUSHJ	PP,@PUTBS(T3)	; OVERPUNCH A "-"
	DPB	C,CPI		;PUT BACK OVERPUNCHED CHARACTER
	JRST	RSTSN1		; AND RETURN

PTRASN:	AOBJP	CCI,PBTHSC	;GET TO LAST CHAR IN STRING
	IBP	CPI
	JRST	PTRASN

PUTBS:	EXP	PUTBS6
	EXP	PUTBS7
	EXP	PUTBS9

;ROUTINES TO OVERPUNCH A "-"
PUTBS6:	ADDI	C,40		;MAKE ASCII CHARACTER
	PUSHJ	PP,PUTBS7	; OVERPUNCH A "-"
	SUBI	C,40		;CONVERT BACK TO SIXBIT
	POPJ	PP,

PUTBS7:	CAIN	C,"0"
	MOVEI	C,":"		;-0
	CAIE	C,":"		;IS IT NOW OVERPUNCHED 0?
	ADDI	C,31		;NO, MAKE A NEGATIVE CHARACTER
	POPJ	PP,

PUTBS9:	ANDI	C,337		;360 BECOMES 320, 361 BECOMES 321, ETC.
	POPJ	PP,

RSTSN1:	POP	PP,AC12		;RESTORE AC12 AGAIN
	POPJ	PP,		;AND RETURN
SUBTTL	INSPECT CONVERTING CODE

INSPC:	MOVE	AC12,(PP)	;RESTORE BYTE POINTER TO INSPECTED STRING
	PUSH	PP,P1
	PUSH	PP,CPA
	MOVE	T1,[TBL,,ICVTB.##]
	BLT	T1,ICVTB.+^D128	;COPY TRANSLATION TABLE TO CONVERSION AREA
	MOVEI	T1,200000	;CODE TO TERMINATE TRANSLATION
	HRLM	T1,ICVTB.

	MOVE	T1,AC12
	LDB	T3,BSI.I	;GET BYTE SIZE INDICATOR OF INSPECTED ITEM

	HLRZ	T2,1(P1)	;GET LOC.3
	MOVE	T2,(T2)

	HRRZ	T4,1(P1)	;GET LOC.4
	MOVE	T4,(T4)

	MOVE	T1,(P1)
	LDB	T5,BSI.L3

	MOVE	T1,(P1)
	LDB	T6,BSI.L4

	TLZ	T2,7777		;GET RID OF GARBAGE IN PTR'S.
	TLZ	T4,7777

	MOVE	T1,[EXP 6,7,9](T5)
	DPB	T1,[POINT 6,T2,11]	;FINISH OFF BYTE POINTER TO L3

	MOVE	T1,[EXP 6,7,9](T6)
	DPB	T1,[POINT 6,T4,11]	;FINISH OFF BYTE POINTER TO L4

	HRRZ	P3,(P1)		;GET ARGUMENT STRING FLAGS
	HLRZ	P3,(P3)
	TXNE	P3,OF%L3C	;IS IT A ONE CHAR VALUE IN L3 ?
	MOVE	T5,T3		;YES, SET CHARACTER MODE SAME AS INSPECTED ITEM
	TXNE	P3,OF%L4C	;IS L4 A ONE CHAR VALUE ?
	MOVE	T5,T3		;YES, SET CHARACTER MODE SAME AS INSPECTED ITEM

	TXNN	P3,OF%L3C	;IS IT CONVERTION OF ONE CHARACTER ONLY ?

INSPC2:	ILDB	CPA,T2		;GET A BYTE FROM THE SEARCH STRING
	JUMPE	CPA,INSPC3	;IF FINISHED, EXIT 
	TXNE	P3,OF%L3C
	HLRZ	CPA,1(P1)
	MOVE	P2,T5
	PUSH	PP,P3
	CAME	T3,P2		;BOTH SEARCH STRING AND INSPECTED STRING SAME TYPE ?
	PUSHJ	PP,INSPC5	;NO, CONVERT CHARACTER TO CORRECT MODE
	POP	PP,P3
	MOVE	CCA,CPA

	TXNN	P3,OF%L4C	;IS IT CONVERTION OF ONE CHARACTER ONLY ?
	ILDB	CPA,T4		;GET A BYTE FROM CONVERTING STRING
	TXNE	P3,OF%L4C
	HRRZ	CPA,1(P1)
	MOVE	P2,T6
	PUSH	PP,P3
	CAME	T3,P2		;BOTH REPLACE STRING AND INSPECTED STRING SAME TYPE ?
	PUSHJ	PP,INSPC5	;NO, CONVERT CHARACTER TO CORRECT MODE
	POP	PP,P3
	ROT	CCA,-1		;DIVIDE CHARACTER VALUE BY TWO
	JUMPL	CCA,[	HRRZ	CCA,CCA
			HRRM	CPA,ICVTB.(CCA)
			JRST	.+2]
	HRLM	CPA,ICVTB.(CCA)
	TXNN	P3,OF%L3C	;IS IT A ONE CHARACTER VALUE ONLY ?
	TXNE	P3,OF%L4C
	TRNA			;YES, EXIT
	JRST	INSPC2

INSPC3:	TLZ	AC12,7777	;SET UP BYTE POINTER TO INSPECTED ITEM
	MOVE	T1,[EXP 6,7,9](T3)
	DPB	T1,[POINT 6,AC12,11]	;FINISH OFF BYTE POINTER TO L3

	POP	PP,CPA
	POP	PP,P1
	MOVE	T1,(P1)
	TLNN	T1,-1		;BEFORE AND/OR AFTER SPECIFIED ?
	 JRST	INSPC4		;NO
	MOVE	T1,(P1)		;GET TEMP BLOCK ADDRESS
	HRRZ	T2,(T1)		;GET AFTER POSITION
	HRRZ	T3,1(T1)	;AND BEFORE POSITION
	CAML	T2,T3		;AFTER POSITION > BEFORE POSITION ?
	JRST	INSPDN		;YES, EXIT
	PUSH	PP,T2
	JUMPE	T2,INSC3A	;JUMP IF NO AFTER STATEMENT
	ADJBP	T2,AC12
	MOVE	AC12,T2
INSC3A:	POP	PP,T2
	SUB	T3,T2		;GET LENGTH OF LINE
	MOVE	CPA,T3
INSPC4:	MOVE	T1,CPA
	AND	T1,[XWD 17777,-1]	;MASK OUT ALL BUT SIZE
	MOVE	T4,T1			;OUTPUT IS SAME SIZE AS INPUT
	TXO	T1,1B0			;SET S BIT FOR STRING TRANSLATED CALL
	MOVE	T2,AC12
	SETZB	T3,T6
	MOVE	T5,AC12
	EXTEND	T1,INSPC9
	 JFCL
	JRST	INSPDN

INSPC9:	MOVST	ICVTB.
	0
	
INSPC5:	CAIE	P2,BSI%SX	;FROM SIXBIT ?
	JRST	INSPC6		;NO
	CAIE	T3,BSI%AS	; TO ASCII ?
	JRST	INSC5A		; NO

	ADDI	CPA,40		;SIXBIT TO ASCII CONVERSION
	POPJ	PP,

INSC5A:	MOVEI	P3,ALP.69	;SIXBIT TO EBCDIC CONVERSION
	JRST	INSPC8

INSPC6:	CAIE	P2,BSI%AS	;FROM ASCII ?
	JRST	INSPC7		;NO, MUST BE EBCDIC
	CAIE	T3,BSI%SX	; TO SIXBIT ?
	JRST	INSC6A		; NO, MUST BE ASCII TO EBCDIC

	MOVEI	P3,ALP.76	;ASCII TO SIXBIT CONVERSION
	JRST	INSPC8

INSC6A:	MOVEI	P3,ALP.79	;ASCII TO EBCDIC CONVERSION
	JRST	INSPC8

INSPC7:	JUMPN	T3,INSC7A	;MUST BE EBCDIC TO ASCII
	MOVEI	P3,ALP.96	;EBCDIC TO SIXBIT CONVERSION
	JRST	INSPC8

INSC7A:	MOVEI	P3,ALP.97	;EBCDIC TO ASCII CONVERSION
	JRST	INSPC8


INSPC8:	ROT	CPA,-1
	JUMPL	CPA,[	HRRZ	CPA,CPA
			ADD	P3,CPA
			HRR	CPA,@P3
			ANDI	CPA,77777
			POPJ	PP,]
	ADD	P3,CPA		;GET ADDRESS OF TABLE ENTRY
	HLR	CPA,@P3
	ANDI	CPA,77777	;MASK OUT BITS USED BY MOVST INSTRUCTION
	POPJ	PP,
SUBTTL	RETURN FROM INSPECT STATEMENT

INSPDN:	POP	PP,AC12		;RESTORE AC12
	TLNE	FLG,FL.OPM	;MUST OVERPUNCH A "-"?
	PUSHJ	PP,RSTSGN	;YES
	TLZ	PA,-1		;CLEAR LH OF AC16
	POPJ	PP,		;RETURN FROM INSPECT

;TABLES

;TT.BA INDEXED BY BSI OF INSPECTED STRING
; TO GET INSTRUCTION IN CV TO CONVERT CHARS FOR COMPARISON

TT.BA:	MOVE	CV,TT.BA6(T3)
	MOVE	CV,TT.BA7(T3)
	MOVE	CV,TT.BA9(T3)

;THE FOLLOWING 3 TABLES ARE INDEXED BY THE BSI OF THE SEARCH STRING (IN T3)
; ENTRIES ARE THE INSTRUCTION TO PUT INTO CV

TT.BA6:	NOP
	LDB	C,IPT67C##
	LDB	C,IPT69C##

TT.BA7:	LDB	T1,IPT671##
	NOP
	LDB	C,IPT79C##

TT.BA9:	LDB	T1,IPT691##
	LDB	T1,IPT791##
	NOP

;TT.REP INDEXED BY BSI OF INSPECTED STRING
; TO GET INSTRUCTION IN CV TO CONVERT CHARS FOR REPLACING

TT.REP:	MOVE	CV,TT.RE6(T3)
	MOVE	CV,TT.RE7(T3)
	MOVE	CV,TT.RE9(T3)

TT.RE6:	NOP
	LDB	T1,IPT761##
	LDB	T1,IPT961##

TT.RE7:	LDB	T1,IPT671##
	NOP
	LDB	T1,IPT971##

TT.RE9:	LDB	T1,IPT691##
	LDB	T1,IPT791##
	NOP

;The next table is used for the INSPECT CONVERTING MOVST JSYS call.

ZZ==0
TBL:	REPEAT	^D128,<XWD ZZ,ZZ+1
		ZZ=ZZ+2>

END