Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
squirl.mac
There are 7 other files named squirl.mac in the archive. Click here to see a list.
; UPD ID= 1805 on 4/4/79 at 2:15 PM by N:<NIXON>
TITLE SQUIRL FOR COBOL V12
SUBTTL SYNTAX TREE TRACER W.NEELY/CAM/SEB
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
MCS==:MCS
TCS==:TCS
DBMS==:DBMS
DEBUG==:DEBUG
RPW==:RPW
;EDITS
;NAME DATE COMMENTS
;V12*****************
;JSM 28-MAR-79 [670] FIX NESTED IF . ELSE PROBLEM
;V10*****************
;EHM 11-AUG-77 [506] ADD TEST FOR OVERFLOW OF DATTAB ETC. AND MAKE A CLEAN EXIT.
; 5-JAN-77 [415] ADD TEMTAB TABLE FOR USE
;SSC MAR-5-75 PLACED 6A EDIT %316 DIRECTLY IN V10
;DBT 4/17/75 STRAIGHTEN OUT TABLES INDEXED BY TABLE
; INDICES
;********************
TWOSEG
RELOC 400000
;THIS ROUTINE READS THE SOURCE PROGRAM AND TRACES IT
;THROUGH THE SYNTAX TREES.
;THE SYNTAX TREES ARE:
; IDTREE & EDTREE IN COBOLB.MAC,
; DDTREE IN COBOLC.MAC
; PDTREE IN COBOLD.MAC
;THE STANDARD FORMAT OF A TREE ENTRY (CALLED A NODE) IS:
;NAME: XWD ACTION-ADDRESS,MISC-CODES
; THE REMAINDER OF THE ENTRY CONSISTS OF HALF WORDS
; WHICH CONTAIN THE ADDRESSES OF OTHER NODES (CALLED SONS)
; TO WHICH SQUIRL CAN NOW BRANCH. THE LAST SON IS
; CALLED THE DEFAULT NODE.
;THE MISC-CODES ARE AS FOLLOWS:
;BITS 18-23 NUMBER OF BRANCHES AT THIS NODE (MINUS 1)
;BIT 24 1 IF THIS IS A PUSH-DOWN NODE
;BIT 25 1 IF THIS ITEM MUST BEGIN AT THE A-MARGIN
;BITS 26-35 THE ITEM-TYPE WHICH GOT SQUIRL TO THIS NODE
;SQUIRL STARTS AT THE FIRST NODE IN THE TREE. IT CALLS GETITM TO
;SCAN THE NEXT SOURCE ITEM AND DETERMINE ITS TYPE (E.G., DATA-NAME,
;RESERVED WORD, LITERAL). SQUIRL THEN COMPARES THIS TYPE-CODE WITH
;THE CODE OF EACH NODE TO WHICH THE CURRENT NODE CAN BRANCH. IF
;IT GETS A MATCH, THE ACTION SPECIFIED BY THAT BRANCH NODE IS
;EXECUTED, THEN THAT SON BECOMES THE CURRENT NODE AND THE PROCESS
;REPEATS.
;IF NO MATCH IS MADE, THE ACTION AT THE LAST (DEFAULT) NODE IS
;EXECUTED, AND THE DEFAULT NODE IS MADE THE CURRENT NODE.
;IF THERE IS ONLY 1 SON (DEFAULT), GETITM IS NOT CALLED.
;IN CERTAIN CASES SQUIRL USES A PART OF THE TREE AS A SUBTREE
;(ARITHMETIC EXPRESSIONS, CONDITIONAL EXPRESSIONS). IN THESE
;CASES THE CALLING NODE IS REFERRED TO AS A PUSH-DOWN NODE. ONCE
;THE SUBTREE IS EXHAUSTED, CONTROL RETURNS TO THE CURRENT NODE.
ENTRY SQURL.
SQURL.: MOVE NODE,(NODPTR) ;GET ADDRESS OF CURRENT NODE
IFN DEBUG,<
PUSHJ PP,PTNOD.## ;IF TRACING, LIST NODE+ACTION+ITEM
PUSHJ PP,PTACT.##
PUSHJ PP,PTTYP.##
>
HLRZ TA,(NODE) ;GET ACTION ADDRESS
JUMPE TA,SQGET ;JUMP IF NULL
CAIG TA,4000 ;IS IT AN ERROR OR AN ACTION?
JRST SQEUUO ;ERROR
PUSHJ PP,(TA) ;OTHERWISE PERFORM ACTION
SQGET: HRRZ NODE,(NODPTR) ;RE-GET ADDRESS OF CURRENT NODE
LDB NSONS,[POINT 6,(NODE),23] ;GET NUMBER OF DESCENDANTS
JUMPE NSONS,SQSHF ;0 IMPLIES DEFAULT ONLY
CAIN NSONS,77
JRST SQG.ER ;-1 IMPLIES NO SONS --- ERROR
MOVEM TYPE,PRVTOK## ;[670] SAVE ASIDE PREV TOKEN FLAG
IFN DBMS,<
SKIPN FINVOK## ;ARE WE IN AN INVOKE?
JRST SQ1 ;NO, PROCEED AS USUAL
MOVEM NODPTR,DBNODE##
PUSHJ PP,GETITM ;GET NEW WORD
SKIPN FINVOK ;RE-GET ITEM IF EOF WAS SEEN
SQ1:
>
PUSHJ PP,GETITM## ;GET NEXT SOURCE ITEM
MOVE NODE,(NODPTR) ;GET ADDRESS OF CURRENT NODE
HRRZ NSONS,(NODE) ;GET # OF DESCENDANT NODES (RIGHT JUSTIFIED)
LSH NSONS,-14
MOVE TA,[POINT 18,1(NODE)] ;SET UP BYTE POINTER TO SONS
MOVEM TA,PNTR## ;& FALL INTO LOOP
SQ2: ILDB SONADR,PNTR ;GET NEXT SON'S ADDRESS
JUMPE SONADR,SQG.ER ;NULL ADDRESS --- ERROR
MOVE SON,(SONADR) ;FIRST WORD OF SON
SOJGE NSONS,SQ2A ;JUMP IF NOT LAST SON
HRRZ NSONS,TYPE ;IF DEFAULT SON, EXIT LOOP WITH SON-TYPE IN NSONS
ANDI NSONS,001777
SQ2.2: SWON FREGWD ;TURN ON REGET WORD FLAG SINCE WE LOOKED
JRST SQ3 ;BUT DIDN'T USE IT
SQ2A: XOR SON,TYPE ;NOT DEFAULT --- COMPARE ITEM-TYPE & SON-TYPE
TRNE SON,002000 ;IS MARGIN REQUIREMENT SAME IN ITEM AND SON?
TRNE TYPE,002000 ;NO --- SKIP IF A-MARGIN REQUIRED
TRNE SON,001777 ;SKIP IF SAME TYPES
JRST SQ2 ;DIFFERENT --- TRY NEXT SON
JRST SQ3 ;SON MATCHES --- EXIT LOOP
;ARRIVE HERE IF ONLY ONE SON
SQSHF: HLRZ SONADR,1(NODE) ;GET ADDRESS OF SON'S ADDRESS
MOVE SON,(SONADR) ;GET SON'S ADDRESS
SQ3: HRRZM SONADR,(NODPTR) ;MAKE SON THE CURRENT NODE
TRNN SON,004000 ;IS THIS A PUSHDOWN NODE?
JRST SQURL. ;NO
IFN DEBUG,<PUSHJ PP,PTPSH.##> ;LIST NODE PUSHING DOWN FROM
HRRZ SONADR,(NODPTR) ;GET ADDRESS OF CURRENT NODE
HLRZ TA,(SONADR) ;ACTION ADDRESS BECOMES CURRENT NODE
PUSH NODPTR,TA
JRST SQURL. ;GO TO NEW NODE
;BAD NODE CODE
SQG.ER: TTCALL 3,[ASCIZ /?COMPILER ERROR --- IMPROPER SYNTAX TREE
/]
IFN DEBUG,<
PUSHJ PP,LCRLF## ;CR-LF TO LISTING
PUSHJ PP,SQ25AS ;25 *'S TO LISTING
MOVE TE,-1(NODE) ;NAME OF NODE
MOVE TD,[POINT 6,TE]
HRRZI TC,6
ILDB CH,TD
ADDI CH,40
PUSHJ PP,PUTLST##
SOJG TC,.-3
MOVEI TE,(NODE) ;ADDRESS OF NODE TO LISTING
MOVE TD,[POINT 3,TE,17]
HRRZI TC,6
ILDB CH,TD
ADDI CH,"0"
PUSHJ PP,PUTLST
SOJG TC,.-3
PUSHJ PP,SQ25AS ;25 *'S TO LISTING
PUSHJ PP,LCRLF ;CR-LF TO LISTING
>
JRST KILL## ;"CATASTROPHE"
;PERFORM ERROR ACTION
SQEUUO: HRLI TA,(EWARNW) ;MAKE EWARNW BE#. INTSRUCTION
XCT TA ;PERFORM THE ERROR UUO
JRST SQGET ;CONTINUE THROUGH TREE
;PUT 25 ASTERISKS IN LISTING FILE
IFN DEBUG,<
SQ25AS: HRRZI TC,25 ;25 CHAR CTR
HRRZI CH,"*"
PUSHJ PP,PUTLST ;LIST AN ASTERISK
SOJG TC,.-1
POPJ PP,
>
SUBTTL TABLE AND STRING MANIPULATION ROUTINES
ENTRY PUTLNK,FNDLNK,FNDNXT,GETENT,GETLOC,GETVAL,GETV2,FINDAT
;PUTLNK INSERTS A TABLE ENTRY IN A NAMTAB SAME NAME CHAIN
;AT ENTRY TA==XWD TABLE ENTRY REL. ADDR.,NAMTAB REL. ADDR.
;THERE ARE NO EXIT PARAMETERS
PUTLNK: HLRZM TA,NEWENT## ;SAVE REL. ADDR. OF NEW ENTRY
ANDI TA,077777
HRRZ TB,NAMLOC## ;NAMTAB S.A.
ADD TA,TB ;NAMTAB ENTRY ABS. ADDR.
LDB TB,[POINT 3,NEWENT,20]
HRRZM TB,NEWTYP## ;TYPE CODE FOR NEW ENTRY
PUTLP: HRRZ TB,(TA) ;LINK ADDRESS
JUMPN TB,PUTCMP ;JUMP IF NOT END OF CHAIN
HRRZ TB,NEWENT ;MAKE CURRENT ENTRY POINT
HRRM TB,(TA) ;TO NEW ONE
POPJ PP,
PUTCMP: HRRZ TC,TB
LSH TC,-17 ;TYPE OF LINK ENTRY
CAML TC,NEWTYP
JRST INSRT ;INSERT IN CHAIN
HRRZ TA,TB ;REL. ADDR. OF LINK
PUSHJ PP,LNKSET## ;GET ABS. ADDR. OF LINK IN TA
JRST PUTLP
INSRT: HRRZM TB,SAVE1## ;SAVE LINK
HRRZ TB,NEWENT ;MAKE CURRENT ENTRY POINT
HRRM TB,(TA) ;TO NEW ENTRY
HRRZ TA,TB
PUSHJ PP,LNKSET ;GET ABS. ADDR. OF NEW ENTRY
HRRZ TB,SAVE1 ;MAKE NEW ENTRY POINT WHERE
HRRM TB,(TA) ;CURRENT ENTRY DID
POPJ PP,
;FNDLNK FINDS, IN A SAME NAME CHAIN, A LINK TO A SPECIFIED TABLE
;AT ENTRY TA==XWD 0,REL. ADDR. OF NAMTAB ENTRY
;AND TB==TYPE CODE OF TABLE SOUGHT
;SUCCESS RETURN = CALLING ADDRESS + 2
; TB==XWD REL. ADDR. OF ENTRY FOUND,ABS. ADDR. OF ENTRY FOUND
;FAILURE RETURN = CALLING ADDRESS + 1
;FNDNXT FINDS NEXT ENTRY OF SAME TYPE AS LAST ENTRY TO FNDLNK SOUGHT
;ENTRY PARAMETER IS TA==ABS. ADDR. OF LAST LINK FOUND IN CHAIN
FNDLNK: ANDI TA,077777 ;NAMTAB REL. ADDR.
HRRZ TC,NAMLOC ;NAMTAB S. A.
ADD TA,TC ;NAMTAB ENTRY ABS. ADDR.
HRRZM TB,SAVE1 ;SAVE TYPE SOUGHT
FNDNXT: HRRZ TC,(TA) ;LINK WORD
JUMPN TC,.+2
POPJ PP, ;FAILURE
HRLZM TC,SLNK## ;SAVE REL. ADDR.
HRRZ TB,TC
LSH TB,-17 ;TYPE OF LINK
CAMLE TB,SAVE1 ;COMPARE TO TYPE SOUGHT
POPJ PP, ;FAILURE
XCT GETLOC(TB) ;GET TABLE S.A. IN TD
ANDI TC,077777 ;ENTRY REL. ADDR.
ADD TC,TD ;ENTRY ABS. ADDR.
HRRZ TA,TC
CAME TB,SAVE1 ;SKIP IF FOUND
JRST FNDNXT
HRRZ TB,TA ;ABSOLUTE ADDRESS OF ENTRY
HLL TB,SLNK ;RELATIVE ADDRESS OF ENTRY
POP PP,TE ;RETURN ADDRESS
JRST 1(TE) ;SUCCESS EXIT
;GETENT FINDS AN ENTRY OF A GIVEN SIZE IN A SPECIFIED TABLE,
; EXPANDING THE TABLE IF NECESSARY
;AT ENTRY TA==XWD TABLE TYPE CODE,ENTRY SIZE
;AT EXIT TA=XWD ENTRY REL. ADDR.,ENTRY ABS. ADDR.
GETENT: HLRZ TC,TA ;TABLE TYPE
XCT GETNXT(TC) ;NEXT-HOLE WORD IN TB
MOVE CP,TB ;SAVE NEXT HOLE POINTER
HRLZ TD,TA
HRR TD,TA ;ENTRY SIZE IN BOTH HALVES OF TD
HRRZ TE,TD ;SAVE SIZE
ADD TD,TB
JUMPGE TD,XPNIT ;NOT ENOUGH ROOM--EXPAND
XCT PUTNXT(TC) ;UPDATE NEXT-HOLE WORD
HRRZI LN,0
PUSH CP,LN ;CP WILL POINT TO ACTUAL ENTRY
HRRZ TA,CP ;ABS. ADDR. OF ENTRY IN RIGHT HALF OF TA
XCT GETSA(TC) ;GET S.A. OF TABLE IN TD
HRRZ TB,TA ;ENTRY ABS. ADDR.
SUB TB,TD
CAILE TB,77777 ;[506] IF TABLE BIGGER THAN 32768
CAIL TC,3 ;[506] AND IF FILTAB,DATTAB OR CONTAB
SKIPA ;[506] O.K. EITHER SMALLER OR OTHER TABLE
JRST OVRFLO ;[506] TABLE OVERFLOW TROUBLE!!
CAILE TC,7
HRRZI TC,0
LSH TC,17
OR TB,TC ;ENTRY TYPE CODE
HRL TA,TB ;L. H. OF TA==REL. ADDR. OF ENTRY
HRRZ TB,TA ;R. H. OF TB==ABS. ADDR. OF ENTRY
SETZM (TB)
ADDI TB,1
SOJG TE,.-2 ;ZERO OUT ENTRY
POPJ PP,
XPNIT: MOVEM TA,SAVETA## ;SAVE PARAMETER
PUSHJ PP,@XPNTBL(TC) ;EXPAND TABLE
MOVE TA,SAVETA ;RESTORE PARAMETER
JRST GETENT ;TRY AGAIN
OVRFLO: XCT GIVERR(TC) ;[506] GIVE USER PROPER ERROR MESSAGE
MOVEI TA,"C" ;[506] QUIT NEEDS TO KNOW PHASE NUMBER
MOVEM TA,PHASEN## ;[506] SO BE SURE IT IS THERE
JRST QUITS## ;[506] THERE IS NOTHING MORE WE CAN DO
;[506] TO HELP USER DUMP IS NO USE HERE
GIVERR: TTCALL 3, [ASCIZ /?FILE TABLE OVERFLOW FILE SECTION TOO BIG/] ;[506]
TTCALL 3, [ASCIZ /?DATA TABLE OVERFLOW DATA DIVISION TOO BIG/] ;[506]
TTCALL 3, [ASCIZ /?CONDITION TABLE OVERFLOW TOO MANY LEVEL 88/];[506]
GETNXT: MOVE TB,FILNXT## ;FILTAB
MOVE TB,DATNXT## ;DATTAB
MOVE TB,CONNXT## ;CONTAB
MOVE TB,LITNXT## ;LITTAB AND VALTAB
MOVE TB,PRONXT## ;PROTAB
MOVE TB,EXTNXT## ;EXTTAB
MOVE TB,VALNXT## ;VALTAB
MOVE TB,MNENXT## ;MNETAB
MOVE TB,FLONXT## ;FLOTAB
MOVE TB,CPYNXT## ;CPYTAB
MOVE TB,HLDNXT## ;HLDTAB
MOVE TB,RPWNXT## ;RPWTAB
IFN DBMS,<
MOVE TB,USENXT##
;[%316] RECORD TABLE NO LONGER NECES MOVE TB,DBRNXT##
MOVE TB,DBDNXT##
>
IFE DBMS,<
0
0
>
IFE MCS!TCS,<
0
>
IFN MCS!TCS,<
MOVE TB,CDNXT##
>
MOVE TB,TEMNXT## ; [415] TEMTAB
PUTNXT: MOVEM TD,FILNXT
MOVEM TD,DATNXT
MOVEM TD,CONNXT
MOVEM TD,LITNXT
MOVEM TD,PRONXT
MOVEM TD,EXTNXT
MOVEM TD,VALNXT
MOVEM TD,MNENXT
MOVEM TD,FLONXT
MOVEM TD,CPYNXT
MOVEM TD,HLDNXT
MOVEM TD,RPWNXT
IFN DBMS,<
MOVEM TD,USENXT
;[%316] REC TAB NO LONGER NECES MOVEM TD,DBRNXT
MOVEM TD,DBDNXT
>
IFE DBMS,<
0
0
>
IFE MCS!TCS,<
0
>
IFN MCS!TCS,<
MOVEM TD,CDNXT
>
MOVEM TD,TEMNXT ; [415] TEMTAB
GETLOC:
GETSA: HRRZ TD,FILLOC##
HRRZ TD,DATLOC##
HRRZ TD,CONLOC##
HRRZ TD,LITLOC##
HRRZ TD,PROLOC##
HRRZ TD,EXTLOC##
HRRZ TD,VALLOC##
HRRZ TD,MNELOC##
HRRZ TD,FLOLOC##
HRRZ TD,CPYLOC##
HRRZ TD,HLDLOC##
HRRZ TD,RPWLOC##
IFN DBMS,<
HRRZ TD,USELOC##
;[%316] HRRZ TD,DBRLOC##
HRRZ TD,DBDLOC##
>
IFE DBMS,<
0
0
>
IFE MCS!TCS,<
0
>
IFN MCS!TCS,<
HRRZ TD,CDLOC##
>
HRRZ TD,TEMLOC## ; [415] TEMTAB
XPNTBL: XWD 0,XPNFIL##
XWD 0,XPNDAT##
XWD 0,XPNCON##
XWD 0,XPNLIT##
XWD 0,XPNPRO##
XWD 0,XPNEXT##
XWD 0,XPNVAL##
XWD 0,XPNMNE##
XWD 0,XPNFLO##
XWD 0,XPNCPY##
XWD 0,XPNHLD##
XWD 0,XPNRPW##
IFN DBMS,<
XWD 0,XPNUSE##
;[%316] XWD 0,XPNDBR##
XWD 0,XPNDBD##
>
IFE DBMS,<
0
0
>
IFE MCS!TCS,<
0
>
IFN MCS!TCS,<
XWD 0,XPNCD##
>
XWD 0,XPNTEM## ; [415] TEMTAB
;GETVAL CONVERTS AN ASCII STRING OF CHARACTERS TO THE BINARY
; INTEGER IT REPRESENTS
;THE FIRST CHARACTER MAY BE A SIGN
;AT ENTRY TA==ABS. ADDR. OF CHARACTER STRING
;AND CTR==NUMBER OF CHARACTERS IN STRING
;AT EXIT TC==VALUE
;NO VALIDITY CHECKING OF THE INPUT IS PERFORMED
GETVAL: MOVE TD,[POINT 7,(TA)]
GETV2: SETZ TC, ;VALUE
HRRZI TE,1 ;SIGN
ILDB TB,TD ;FIRST CHARACTER
CAIN TB,53 ;+ SIGN?
JRST ENDLP ;YES
CAIE TB,55 ;- SIGN?
JRST GO ;NO
SETO TE, ;YES
JRST ENDLP
GETLP: ILDB TB,TD ;DIGIT
GO: ANDI TB,17 ;VALUE
IMULI TC,12 ;NUMBER*10.
ADD TC,TB ;+ DIGIT
ENDLP: SOSLE CTR##
JRST GETLP
IMUL TC,TE ;SIGN
POPJ PP,
;FIND AN ITEM IN DATAB
;ITEM SPECIFIED IN TBLOCK AS FOLLOWS:
;TBLOCK+0: USED TO STORE CURRENT DATAB LINK
; 1: # OF QUALIFIERS
; 2: INDEX TO QUALIFIERS
; 3: LINK TO MATCHING ITEM
; 4: W2 CONTENTS FOR DATA-NAME
; 5: NAMTAB LINK TO 1ST QUAL.
; 6: NAMTAB LINK TO 2ND QUAL.
; ETC.
;RETURNS WITH DATAB LINK IN TE
;OR WITH DW, LN, CP SET IF THERE WAS AN ERROR
FINDAT: LDB TA,[POINT 15,TBLOCK+4,15] ;GET 1ST DATAB LINK FOR ITEM
MOVEI TB,CD.DAT
PUSHJ PP,FNDLNK
JRST FINDE1 ;NOT DEFINED
SETZM CTR ;CLR MATCH CTR
FIND11: MOVEM TB,TBLOCK## ;SAVE DATAB LINK OF ITEM
HLRZ TC,TB ;TC ALWAYS HAS LINK IN RIGHT HALF
SETZM TBLOCK+2 ;INIT QUALIFIER INDEX
SKIPN TBLOCK+1 ;ANY QUALIFIERS?
JRST FIND8 ;NO, THIS IS A MATCH
FIND5: AOS TB,TBLOCK+2 ;AIM AT NEXT QUALIFIER
CAMLE TB,TBLOCK+1 ;FINISHED ALL QUALS?
JRST FIND8 ;YES, WE HAVE A MATCH
HRRZ TD,TBLOCK+4(TB) ;NO, GET NAMTAB LINK OF NEXT QUAL
FIND6: HRRZI TA,(TC) ;AIM AT DATAB ENTRY
ANDI TA,077777
ADD TA,DATLOC
LDB TC,DA.BRO## ;GET FATHER/BROTHER LINK
JUMPE TC,FIND14 ;DOESN'T HAVE ONE
LDB TB,DA.FAL## ;IS IT A FATHER LINK?
JUMPE TB,FIND6 ;NO, KEEP GOING
MOVEI TA,(TC) ;GET FATHERS NAME
ANDI TA,077777
TRNN TC,700000 ;IS THIS A DATAB OR A FILTAB LINK?
JRST FIND3 ;FILTAB
ADD TA,DATLOC
LDB TB,DA.NAM##
CAIE TB,(TD) ;DOES NAME MATCH ONE WE WANT?
JRST FIND6 ;NO
JRST FIND5 ;YES, TRY NEXT QUAL.
FIND3: MOVEI TE,(TA) ;SAVE EXTRA COPY OF TA
MOVE TB,TBLOCK+2 ;MAKE SURE NO QUALS ABOVE THIS
CAMGE TB,TBLOCK+1
JRST FIND15 ;FILE CAN'T BE A MATCH SINCE THERE ARE MORE QUALS
HRRZ TB,FILLOC ;OK, GET ABS. FILTAB PTR
ADDI TA,(TB)
HRRZ TB,FILNXT ;IS PTR IN FILTAB RANGE?
CAILE TA,(TB)
JRST FIND14 ;NO
LDB TB,FI.NAM## ;WHAT'S HIS NAME?
CAIE TB,(TD) ;IS IT WHAT WE WANT?
JRST FIND14 ;NO
IFE RPW,<
FIND8: >
AOS CTR ;COUNT MATCHING ITEM
MOVE TA,TBLOCK ;& SAVE LINK TO IT
MOVEM TA,TBLOCK+3
FIND14:
IFN RPW,<
HRRZ TA,RPWLOC ;MAKE ABS PTR TO RPWTAB
ADDI TA,(TE)
HRRZ TB,RPWNXT ;IS PTR IN RPWTAB RANGE?
CAILE TA,(TB)
JRST FIND15 ;NO
LDB TB,RW.NAM## ;FIND HIS NAME
CAIE TB,(TD) ;DOES IT MATCH?
JRST FIND15 ;NO
FIND8: AOS CTR ;COUNT MATCHING ITEM
MOVE TA,TBLOCK ;& SAVE LINK TO IT
MOVEM TA,TBLOCK+3
>
FIND15:
MOVE TA,TBLOCK ;GET NEXT DATAB ITEM IN SAME-NAME CHAIN
PUSHJ PP,FNDNXT
JRST FIND10 ;NO MORE OF THIS NAME
JRST FIND11 ;OK, TRY THIS ONE FOR A MATCH
FIND10: MOVE TE,CTR
JUMPE TE,FINDE1 ;IF CTR = 0, ITEM IS NOT DEFINED
SOJG TE,FINDE2 ;IF CTR > 1, QUALIFICATION IS AMBIGUOUS
HLRZ TE,TBLOCK+3 ;IF CTR = 1, GET DATAB LINK TO THE MATCH
SETZ DW, ;NO ERRORS
POPJ PP,
FINDE1: HRRZI DW,E.104 ;UNDEFINED
FINDEX: LDB LN,[POINT 13,TBLOCK+4,28]
LDB CP,[POINT 7,TBLOCK+4,35]
POPJ PP,
FINDE2: HRRZI DW,E.332 ;INSUFFICIENT QUALIFICATION
JRST FINDEX
END