Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/trynam.mac
There are 9 other files named trynam.mac in the archive. Click here to see a list.
; UPD ID= 2623 on 3/7/80 at 4:56 PM by NIXON
TITLE TRYNAM FOR COBOL V12B
SUBTTL FIND AN ENTRY IN NAMTAB AL BLACKINGTON/CAM
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
DEBUG==:DEBUG
;EDITS
;V10*****************
;NAME DATE COMMENTS
;********************
; EDIT 267 FIX ILL MEF REF FOR NAMETAB SEARCHES
TWOSEG
RELOC 400000
ENTRY BLDNAM ;BUILD UP AN ENTRY
ENTRY TRYNAM ;TRY TO FIND AN ENTRY
EXTERNAL ADDCOR,BLTUP,KILL,KILLF
;THREE TABLES ARE USED:
; 1) NM1TAB - A TABLE OF HASH-TOTALS
; 2) NM2TAB - FOR EACH ENTRY OF NM1TAB, THE CORRESPONDING ENTRY
; IN NM2TAB CONTAINS:
; LH - SIZE OF THE NAME, IN WORDS
; RH - LOCATION OF THE WORD IN NAMTAB, RELATIVE TO
; THE START OF NAMTAB
; 3) NAMTAB - THE NAMES, IN SIXBIT (SEE MEMO# 100-350-011)
;AN ATTEMPT IS MADE TO FIND AN ENTRY MATCHING NAMWRD IN THE FOLLOWING MANNER:
; 1) HASH-TOTAL NAMWRD BY XORING THE FIVE WORDS TOGETHER, THEN XORING THE
; HALVES OF THE RESULT.
; 2) DIVIDE THE HASH-TOTAL BY THE SIZE OF NM1TAB (NM12SZ).
; THE QUOTIENT BECOMES Q, THE REMAINDER R(0).
; 3) IF NM1TAB (R) IS UNEQUAL TO THE HASH-TOTAL, GO TO STEP 5.
; 4) IF THE NAMTAB ENTRY, WHOSE RELATIVE ADDRESS IS IN THE RH OF
; NM2TAB (R), IS EQUAL TO NAMWRD, THE MATCH IS MADE
; AND THE ROUTINE EXITS; ELSE GO TO STEP 6.
; 5) IF NM2TAB (R) IS ZERO, THERE IS NO MATCHING ENTRY.
; 6) COMPUTE A NEW R BY ADDING Q TO R. NOTE THAT
; R(I) = R(0) + Q*I
; 7) STEPS 3 THRU 6 ARE EXECUTED "NM12SZ" TIMES, THEN NO MORE
; ATTEMPTS ARE MADE, AND THE COMPILATION IS ABORTED.
Q=TD
R=TC
;LOOK FOR AN ENTRY
TRYNAM: IFN DEBUG,< AOS NAMCT1
SETZM NAMCT0>
MOVEM TF,SAVEAC+1 ;SAVE "TF"
MOVEM TG,SAVEAC ;SAVE "TG"
PUSHJ PP,INITAL ;INITIALIZE
JRST TRYN1B
TRYN1A: ADD R,Q ;R_R+Q
CAML R,NM12SZ ;STILL INSIDE TABLE?
SUB R,NM12SZ ;NO--INSURE THAT IT IS
TRYN1B: IFN DEBUG,< AOS NAMCT0 >
CAMN TE,@NM1LOC ;IS THIS THE ONE WE WANT?
JRST COMPAR ;MAYBE--CHECK THE FIVE WORDS
SKIPN @NM2LOC ;NO--IS THERE ANYTHING HERE?
JRST NOFIND ;NO--ENTRY NOT IN THE TABLE
NOMACH: SOJG TG,TRYN1A ;YES--LOOP
JRST NOFIND ;TRIED ALL THE TABLE--WE LOSE
;COMPARE UP TO FIVE WORDS IN NAMTAB AGAINST NAMWRD
COMPAR: MOVE TA,@NM2LOC
HLRZ TF,TA
ADD TA,NAMLOC
MOVE TB,NAMWRD
CAME TB,1(TA)
JRST NOMACH
SOJLE TF,TRYN1C
SKIPE TB,NAMWRD+1
CAME TB,2(TA)
JRST NOMACH
SOJLE TF,TRYN2
SKIPE TB,NAMWRD+2
CAME TB,3(TA)
JRST NOMACH
SOJLE TF,TRYN3
SKIPE TB,NAMWRD+3
CAME TB,4(TA)
JRST NOMACH
SOJLE TF,TRYN4
SKIPE TB,NAMWRD+4
CAME TB,5(TA)
JRST NOMACH
;A MATCHING ENTRY WAS FOUND
MATCH: AOS (PP) ;SKIP UPON EXITING
MOVE TD,TA ;RELATIVE LOC PUT IN LH OF TA
SUB TD,NAMLOC
HRL TA,TD
;NO MATCHING ENTRY FOUND
NOFIND: IFN DEBUG,<
MOVE TF,NAMCT0
ADDM TF,NAMCT2
CAILE TF,DISTSZ
MOVEI TF,DISTSZ
AOS NAMDIS-1(TF)>
MOVE TF,SAVEAC+1
MOVE TG,SAVEAC
POPJ PP,
;NAMTAB ENTRY MAY BE SHORTER THAN NAMWRD ENTRY
TRYN1C: SKIPE NAMWRD+1
JRST NOMACH
JRST MATCH
TRYN2: SKIPE NAMWRD+2
JRST NOMACH
JRST MATCH
TRYN3: SKIPE NAMWRD+3
JRST NOMACH
JRST MATCH
TRYN4: SKIPE NAMWRD+4
JRST NOMACH
JRST MATCH
;ADD AN ENTRY TO NAMTAB
BLDNAM: IFN DEBUG,< AOS NAMCT3 >
MOVEM TG,SAVEAC ;SAVE "TG"
BLDNM0: PUSHJ PP,INITAL ;INTIALIZE
JRST BLDN1B
BLDN1A: ADD R,Q
CAML R,NM12SZ
SUB R,NM12SZ
BLDN1B: SKIPE TA,@NM2LOC ;ANY ENTRY HERE?
JRST BLDN5 ;YES
MOVEM TE,@NM1LOC ;NO--THIS IS WHERE IT GOES
MOVE TA,NAMNXT ;SET UP TA
ADDI TA,1
MOVEI TB,5 ;FIND THE LENGTH OF NAMWRD
SKIPN NAMWRD-1(TB)
SOJG TB,.-1
JUMPE TB,BADNAM ;WAS IT ZERO?
MOVE TE,TA ;NO--PUT ENTRY IN NM2TAB
SUB TE,NAMLOC
HRL TE,TB
MOVEM TE,@NM2LOC
MOVEI Q,1(TB) ;KICK UP NAMNXT
HRLS Q
ADDB Q,NAMNXT
AOBJN Q,.+2 ;TABLE ALMOST FULL?
;NOTE: DO AN AOBJN SO THAT THERE IS
; AT LEAST ONE NULL WORD AT THE END
; OF THE TABLE TO TERMINATE THE
; LAST STRING IN THE TABLE IN CASE IT
; IS 6 CHARS LONG.
PUSHJ PP,XPNNAM ;YES--EXPAND THE TABLE
SETZM 0(TA) ;CLEAR THE FIRST WORD.
ADD TB,TA ;MOVE IN THE ENTRY
MOVEI Q,1(TA)
HRLI Q,NAMWRD
BLT Q,0(TB)
HRL TA,TE ;SET LH OF TA TO RELATIVE LOCATION
MOVE TG,SAVEAC
POPJ PP, ;RETURN
BLDN5: SOJG TG,BLDN1A
JRST ADDTAB
;INTIALIZE
INITAL: MOVE TE,NAMWRD
IFN ANS74,<
SKIPE FLGSW## ;DO WE NEED FIPS FLAGGER?
SKIPN DEBSW## ;AND IS DEBUG MODE ON?
JRST INITA4 ;NO
CAME TE,['DEBUG:'] ;YES, IS IT A POSSIBILITY?
JRST INITA4 ;NO CHANCE
MOVE TE,NAMWRD+1 ;GET NEXT WORD
CAME TE,[SIXBIT /ITEM/] ;DEBUG-ITEM
CAMN TE,[SIXBIT /LINE/] ;DEBUG-LINE
JRST INITA2
CAME TE,[SIXBIT /NAME/] ;DEBUG-NAME
CAMN TE,[SIXBIT /SUB:1/] ;DEBUG-SUB-1
JRST INITA2
CAME TE,[SIXBIT /SUB:2/] ;DEBUG-SUB-2
CAMN TE,[SIXBIT /SUB:3/] ;DEBUG-SUB-3
JRST INITA2
CAME TE,[SIXBIT /CONTEN/] ;DEBUG-CONTENTS
JRST INITA3 ;NO POSSIBILITY
MOVE TE,NAMWRD+2 ;GET THIRD WORD OF NAME
CAMN TE,[SIXBIT/TS/]
JRST INITA2 ;DEBUG-CONTENTS
MOVE Q,NAMWRD+3 ;GET FORTH WORD ALSO
CAMN TE,[SIXBIT /TS:DIS/]
JRST [SKIPE NAMWRD+4 ;FIFTH WORD BETTER BE ZERO
JRST INITA3 ;TOO BAD
CAME Q,[SIXBIT /PLAY:6/]
CAMN Q,[SIXBIT /PLAY:7/]
JRST INITA1 ;FLAG "NS"
CAMN Q,[SIXBIT /PLAY:9/]
JRST INITA1
JRST INITA3]
CAME TE,[SIXBIT /TS:1:W/]
CAMN TE,[SIXBIT /TS:2:W/]
JRST [MOVS TE,NAMWRD+4 ;GET FIFTH WORD
CAMN Q,[SIXBIT /ORD:CO/]
CAIN TE,'RD '
JRST INITA1 ;FLAG "NS"
JRST INITA3]
CAMN TE,[SIXBIT /TS:COM/]
CAME Q,[SIXBIT /P:3/]
TRNA
JRST INITA1
CAMN TE,[SIXBIT /TS:IND/]
CAME Q,[SIXBIT /EX/]
JRST INITA3
INITA1: FLAGAT NS
JRST INITA3
INITA2: FLAGAT LI
INITA3: MOVE TE,NAMWRD ;GET FIRST WORD AGAIN
INITA4:>
XOR TE,NAMWRD+1
XOR TE,NAMWRD+2
XOR TE,NAMWRD+3
XOR TE,NAMWRD+4
HLRZ Q,TE
HRRZS TE
CAME Q,TE ;AVOID DIVISION INTO 0
XORB Q,TE
MOVE TG,NM12SZ
IDIVI Q,(TG) ;FORM Q(0), R(0)
ADDI Q,1
POPJ PP,
;INCREASE THE SIZE OF NM1TAB&NM2TAB
ADDTAB: IFN DEBUG,<EXTERNAL LSTMES,LCRLF
PUSH PP,CH
MOVE TE,[POINT 7,[ASCIZ "EXPANDING NM1TAB&NM2TAB"]]
PUSHJ PP,LSTMES
PUSHJ PP,LCRLF
POP PP,CH
>
MOVE TE,NSZPTR ;GET NEXT SIZE FOR TABLES
AOBJP TE,NOROOM ;IF CANNOT MAKE BIGGER, ERROR
MOVEM TE,NSZPTR
ADDTB1: HRRZ TD,(TE) ;PICK UP AND
MOVEM TD,NM12SZ ; SAVE SIZE
SUB TD,-1(TE) ;COMPUTE DIFFERENCE FROM LAST TIME
LSH TD,1 ;DOUBLE IT (TWO TABLES)
HLRZ TC,FREESP ;IS THERE
CAIL TC,(TD) ; ENOUGH ROOM IN FREE SPACE?
JRST ADDTB2 ;YES
PUSHJ PP,MOVNAM ;NO--ADD 1K OF CORE AND MOVE UP NAMTAB
MOVE TE,NSZPTR ;TRY AGAIN WITH
JRST ADDTB1 ; MORE CORE
ADDTB2: HRRZ TD,NAMLOC ;SET
SUB TD,(TE) ; NEW ADDRESSES
HRRM TD,NM2LOC ; FOR NM2TAB
SUB TD,(TE) ; AND
HRRM TD,NM1LOC ; NM1TAB
SUB TD,FREESP ;COMPUTE FREE SPACE
HRLM TD,FREESP ; AND SAVE IT
MOVE TD,NM1LOC ;CLEAR
MOVSI TC,(TD) ; NM1TAB
HRRI TC,1(TD) ; TO
SETOM (TD) ; ALL
ADD TD,(TE) ; ONE
BLT TC,-1(TD) ; BITS
MOVSI TC,(TD) ;CLEAR
HRRI TC,1(TD) ; NM2TAB
SETZM (TD) ; TO ALL
ADD TD,(TE) ; ZERO
BLT TC,-1(TD) ; BITS
HRRZ TD,NAMNXT ;CLEAR FIRST UNUSED
CAMGE TD,.JBREL## ;[267] ARE WE STILL IN USER CORE?
SETZM 1(TD) ; WORD IN NAMTAB
MOVE TD,[XWD NAMWRD,SAVNAM]; SAVE NAMWRD
BLT TD,SAVNAM+4
;INCREASE NM1TAB&NM2TAB (CONT'D)
HRRZ TD,NAMLOC ;SET TD TO
MOVEI TD,1(TD) ; FIRST ENTRY
ADDTB4: SKIPN 1(TD) ;IF THAT IS ONE WE DESTROYED IN CLRNAM,
JRST ADDT10 ; FORGET IT
SETZM NAMWRD ;CLEAR NAMWRD
MOVE TE,[XWD NAMWRD,NAMWRD+1]
BLT TE,NAMWRD+4
MOVEI TC,NAMWRD ;MOVE
MOVEI TE,1(TD) ; ITEM
HRRZ TA,NAMNXT ;[267] GET END OF NAMTAB
ADDTB5: CAIGE TA,0(TE) ;[267] ARE WE STILL WITHIH NAMTAB
JRST ADDTB6 ;[267] NO
MOVE TB,0(TE) ; TO
TLNN TB,3B19 ; NAMWRD
JRST ADDTB6 ; UNTIL
MOVEM TB,(TC) ; 0-BITS
ADDI TC,1 ; SEEN IN
AOBJP TE,ADDTB5 ; FIRST TWO BITS OF A WORD
ADDTB6: PUSH PP,TE ;SAVE ADDRESS OF NEXT ITEM
SUB TD,NAMLOC ;GET RELATIVE ADDRESS
HRRI TE,(TD) ;CREATE NM2TAB ENTRY
PUSH PP,TE ;SAVE IT
PUSHJ PP,INITAL ;CREATE CHECK-SUM
JRST ADDTB8
ADDTB7: ADD R,Q ;STEP TO
CAML R,NM12SZ ; NEXT
SUB R,NM12SZ ; TRIAL ENTRY
ADDTB8: SKIPE TA,@NM2LOC ;IS THERE AN ITEM THERE?
JRST ADDTB7 ;YES--TRY ANOTHER
MOVEM TE,@NM1LOC ;NO--STASH CHECK-SUM
POP PP,@NM2LOC ;STASH POINTER
POP PP,TD ;GET ADDRESS OF NEXT NAMTAB ENTRY
ADDTB9: HRRZ TE,NAMNXT ;ARE WE
CAIL TE,(TD) ; DONE?
JRST ADDTB4 ;NO
MOVS TD,[XWD NAMWRD,SAVNAM];YES
BLT TD,NAMWRD+4 ;RESTORE NAMWRD
JRST BLDNM0 ;TRY ADDING NEW ENTRY AGAIN
ADDT10: MOVEI TD,2(TD) ;WE FOUND A DESTROYED ENTRY,
ADDT11: MOVE TB,(TD) ;SKIP
TLNE TB,3B19 ; PAST
AOJA TD,ADDT11 ; IT
JRST ADDTB9 ;LOOP
;MOVE NAMTAB UP BY 1K
MOVNAM: PUSHJ PP,ADDCOR ;GET ANOTHER 1K OF CORE
HRRZ TE,NAMNXT ;MOVE
ADDI TE,2000 ; UP
HRRZ TB,NAMLOC ; ONLY
PUSHJ PP,BLTUP ; NAMTAB
MOVEI TE,2000 ;INCRMENT
ADDM TE,NAMLOC ; APPROPRIATE
ADDM TE,NM1LOC ; ADDRESSES
ADDM TE,NM2LOC
ADDM TE,NAMNXT
SKIPE CURNAM
ADDM TE,CURNAM
MOVSI TE,2000
ADDM TE,FREESP
POPJ PP,
;ADD 1K TO THE NAME TABLE
XPNNAM: PUSH PP,TE ;SAVE TE.
PUSHJ PP,ADDCOR ;GRAB A 1K BLOCK
MOVSI TE,-2000 ;RESET NAMLOC & NAMNXT
ADDM TE,NAMLOC
ADDM TE,NAMNXT
POP PP,TE ;RESTORE TE
POPJ PP, ;RETURN
BADNAM: TTCALL 3,[ASCIZ "Zero entry in NAMTAB
"]
JRST KILL
NOROOM: TTCALL 3,[ASCIZ "Name table is full
"]
JRST KILLF
EXTERNAL NM1LOC,NM2LOC,NAMNXT,NAMLOC,CURNAM
EXTERNAL NM12SZ,NAMCST,NAMWRD,SAVEAC,SAVNAM,NSZPTR,FREESP
IFN DEBUG,< EXTERNAL NAMCT0,NAMCT1,NAMCT2,NAMCT3,DISTSZ,NAMDIS >
TF=TE-1
TG=TF-1
END