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