From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 16-OCT-1989 20:36
To:	MRGATE::"ARISIA::EVERHART"
Subj:	LIBSEARCH SEARCH for VMS libraries 4/7

Message-Id:  <8910162212.AA05527@crdgw1.ge.com>
Received: From NSFNET-RELAY.AC.UK by CRVAX.SRI.COM with TCP; Mon, 16 OCT 89 11:32:52 PDT
Received: from ncdlab.ulcc.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa10658; 16 Oct 89 17:16 BST
Date:           Mon, 16 Oct 89  17:23 BST
From: "Kevin Ashley - ULCC Networks Development." <KEVIN%ncdlab.ulcc.ac.uk@NSFnet-Relay.AC.UK>
To: INFO-VAX <@NSFnet-Relay.AC.UK:INFO-VAX@crvax.sri.com>
Subject:        LIBSEARCH SEARCH for VMS libraries 4/7

-+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+
X`009        Status = Lib$Sub_Times(Btime,Mhead(3),Rtime)
X`009`009If(Status .eq. %Loc(Lib$_NEGTIM)) Return
X`009    Endif
X`009    If(Since) Then
X`009        Status = Lib$Sub_Times(Stime,Mhead(3),Rtime)
X`009`009If(Status .ne. %Loc(Lib$_NEGTIM)) Return
X`009    Endif
X`009Endif
X
X`009If(Confirm_Module) Then
X`009  If(.Not.Confirmed(Key,.False.)) Return
X`009Endif
X*
X*`009Yes, so find the module.
X*
X`009Status = Lbr$Find(FilIdx,Rfa)
X`009Call Stchek(Status)
X*
X*`009Initialize flags.
X*
X`009Status = 1
X`009Typerest = .False.
X`009Inwindow = .False.
X`009Call Win_Fini
X`009Call Dynini(Rec_Descriptor)
X`009Ctopic = 0
X`009Smatch = 0
X`009Nsub = .False.
X`009SubHelp = Subtopic .and. Helplib
X*
X*`009Get_record returns a variable length descriptor, which
X*`009we then use to pass to our search routine.
X*
X`009Do While (Status)
X`009  Status = GetRec(Filidx,Rec_Descriptor)
X
X`009  If(Status) Then
X`009     Recs = Recs + 1
X`009     Totchr = Totchr + Rec_Descriptor.Len
X*
X*`009If a help library, and subtopic output requested, track current
X*`009subtopic.
X*
X`009     If(SubHelp) Call Xtopic(Rec_Descriptor,Nsub)
X`009     If(Nsub) Smatch = 0      !If new subtopic, zero topic hit count
X*
X*`009Search the record for the target(s)
X*
X`009     SStat = Search_Rec(Rec_Descriptor)
X*
X*`009If search succeeded...
X*
X`009     If(Sstat) Then
X`009`009Matches = Matches + 1                 !Bump hit count
X`009`009Smatch = Smatch + 1`009`009      !And topic hit count
X`009`009If(Remaining) Typerest = .True.       !show all if /REMAINING
X*
X*`009If first match in this module...
X*
X`009       If(Matches .eq. 1) Then                !If first this module
X`009`009If(FmodMatch .eq. 0) Then`009        !If first this file
X*
X*`009Stars for windows at start of file
X*
X`009`009 If(Window .and. Heading) Write(Outlun,Hfm1)`032
X*
X*`009Filenames for /HEADING
X*
X                 If(Heading)`032
X     $                   Write(Outlun,'(A)') Current_File(1:Cfilnaml)
X`009`009Else  If(Window .and. Heading) Then
X*
X*`009Window and heading gets more stars if first this module
X*
X`009`009  Write(Outlun,Hfm2)
X`009`009Endif`009`009!First match this file
X*
X*`009Heading - special case for help libraries with /SUBTOPIC
X*
X                 If(Heading) Then
X`009`009   If(SubHelp .and. Ctopic .gt. 0) Then
X`009`009     Write(Outlun,'(A,<Ctopic>(2x,A))')`032
X     $                        Key,(Topics(I)(1:Ltopics(I)),I=1,Ctopic)
X`009`009   Else
X`009`009      Write(Outlun,'(A)') Key
X`009`009   Endif`009    !Special help format
X`009`009 Endif`009`009    !Heading required.
X
X`009       Else If(SubHelp .and. Ctopic .gt. 0) Then
X*
X*`009First match this subtopic ?
X*
X`009`009If(Smatch .eq. 1 .and. Heading) Then
X`009`009`009   If(Window) Write(Outlun,Hfm4)
X`009`009`009   Write(Outlun,'(A,<Ctopic>(2x,A))')`032
X     $                        Key,(Topics(I)(1:Ltopics(I)),I=1,Ctopic)
X`009        Endif
X`009       Endif`009`009`009`009!First match this module
X*
X*`009Do we need to open a new window ?
X*`009If so, we only output asterisks at the start if this is not the
X*`009first window this subtopic/module
X*`009Otherwise, we output a blank line.
X*
X`009       If(Winbefore + Winafter .gt. 0 .and. .Not. Inwindow) Then
X`009`009If((SubHelp .and. Smatch .gt. 1) .or.
X     $              (.Not. Subhelp .and. Matches .gt. 1)) Then
X`009`009`009Write(Outlun,Hfm3)     !15 asterisks open window
X`009`009Else
X`009`009`009Write(Outlun,'()')
X`009`009Endif
X
X`009`009Do I = -Winbefore,-1,1
X`009`009 Call WinOut(I)
X`009`009Enddo
X`009       Endif`009`009`009`009!Opening window
X
X`009       If(Window) Call Type_Rec(Rec_Descriptor,Recs)
X`009       If(Remaining) Typerest = .True.       !show all if /REMAINING
X
X`009       If(Winafter .gt. 0) Then
X`009`009Inwindow = .True.`009`009`009!Set up for post window
X`009`009Wincnt = Winafter
X`009       Endif
X*
X*`009But if it failed...
X*
X`009     Else If(Typerest) Then`009!If no hit in this record, but /REM
X`009       Call Type_Rec(Rec_Descriptor,Recs)
X`009     Else If(Inwindow) Then     !No hit, but still some /WINDOW lines
X`009       Call Type_Rec(Rec_Descriptor,Recs)
X`009       Wincnt = Wincnt - 1
X
X`009       If(Wincnt .eq. 0) Then
X`009`009Inwindow = .False.`009`009 !Done 'em all
X`009       Endif`009`009`009!End of window
X`009     Endif`009`009`009!Hit in record
X`009  Endif`009`009`009`009!Status OK
X`009Enddo`009`009`009`009!While read OK
X
X*`009If completion status is RMS$_EOF, then fine. Otherwise,
X*`009signal error.
X*
X`009If(Status .eq. %Loc(RMS$_EOF)) Then
X`009`009Search_Module = 1
X`009`009Call Module_End(Key)`009`009!Accumulate stats, report
X`009`009Return
X`009Endif
X
X`009Call Lib$Signal(%val(Status))
X`009Search_Module = Status
X`009Return
X`009End
X
X`009Logical Function Search_rec(Record)
X`009IMPLICIT NONE
X`009Character*(*) Record
X`009Include 'QUALCOM.INC'
X`009Include 'TRGCOM.INC'
X`009Integer Str$get1_dx,Str$Upcase,Str$Free1_Dx,Status
X`009Integer Pos,Hits,Str$Find_First_Substring
X`009Integer I,Dum
X`009Logical First
X`009Data First /.True./
X`009Record /DSCDEF1/ Tstr
X*
X*`009For each target, see if we can find it in the string.
X*`009Terminate when search conditions are satisfied.
X*`009If not exact matching, uppercase the record first.
X*
X`009If(.Not.Exact) Then
X`009   If(First) Then
X`009`009Call Dynini(Tstr)
X`009`009First = .False.
X`009   Endif
X`009   Status = Str$Get1_Dx(Len(Record),Tstr)
X`009   Call Stchek(Status)
X`009   Status = Str$Upcase(Tstr,Record)
X`009   Call Stchek(Status)
X`009Endif
X*
X`009Hits = 0
X`009Do I = 1,Ntargets
X`009 If(.Not.Exact) Then
X`009   Status = Str$Find_First_Substring(Tstr,Pos,Dum,Target(I))
X`009 Else
X`009   Status = Str$Find_First_Substring(Record,Pos,Dum,Target(I))
X`009 Endif
X
X`009 If(Pos .ne. 0) Hits = Hits + 1
X*
X*`009Check if any test is complete.
X*
X`009 If(Match .eq. Match_or .and. Hits .gt. 0) Then
X`009`009Search_Rec = .True.    ! OR succeeds after at least one hit
X`009`009Goto 100
X`009 Else If(Match .eq. Match_Nor .and. Pos .eq. 0) Then
X`009`009Search_Rec = .True.    ! NOR succeeds after at least one failure
X`009`009Goto 100
X`009 Else If(Match .eq. Match_And .and. Pos .eq. 0) Then
X`009`009Search_Rec = .False.    ! AND fails after one failure
X`009`009Goto 100
X`009 Else If(Match .eq. Match_Nand .and. Hits .ne. 0) Then
X`009`009Search_Rec = .False.    ! NAND fails after at least one hit
X`009`009Goto 100
X`009 Endif
X`009Enddo
X*
X*`009Now all is complete, check NAND and AND
X*       The OR or NOR test should have succeeded by now.
X*
X`009If(Match .eq. Match_And .and. Hits .eq. Ntargets) Then
X`009`009Search_Rec = .True.
X`009Else If(Match .eq. Match_NAnd .and. Hits .eq. 0) Then
X`009`009Search_Rec = .True.
X`009Else
X`009`009Search_Rec = .False.
X`009Endif
X
X100`009Continue
X
X`009Return
X`009End
X
X`009Subroutine Xtopic(Record,Nsub)
X*
X*`009This routine is called when we are looking at help libraries and must
X*`009keep track of which subtopic we are in.
X*`009Nsub is set true if there is a new subtopic level.
X*`009/ qualifiers are also treated as subtopics, which can confuse the
X*`009nesting level.
X*`009When we encounter a /-type subtopic, we must remember how we got
X*`009it so that counters can be decremented or not when we encounter
X*`009a new real subtopic level.
X*
X`009Implicit None
X`009Character*(*) Record
X`009Logical Nsub
X`009Character*1 Sp,Tab
X`009Parameter (Sp = Char(32),Tab=Char(9))
X`009Integer Ntopic,I,Lrec
X`009Include 'TOPICS.INC'
X`009Integer Str$Find_First_not_In_Set
X*-------------------------------------------
X* Statement function for digit testing
X*
X`009Logical Digit
X`009Character*1 A
X
X`009Digit(A) = LGE(A,'0') .and. LLE(A,'9')
X*-------------------------------------------
X*
X*`009Skip empty records
X*
X`009Nsub = .False.
X`009If(Len(Record) .eq. 0) Return`032
X*
X*`009Skip records that don't start with a digit or a slash
X*`009Also skip records that start with a digit, but are not followed
X*`009by space or tab.
X*
X`009If(Digit(Record(1:1))) Then
X`009  If(Index(Sp//Tab,Record(2:2)) .eq. 0) Return
X*
X*`009OK, we have a new subtopic/level. Read the level, extract the
X*`009topic.
X*
X`009  Call Str$Trim(Record,Record,Lrec)`009!Dump trailing spaces
X`009  Read(Record(1:1),'(I1)') Ntopic
X`009  Nsub = .True.
X`009  I = str$find_first_not_in_set ( Record(2:),Sp//Tab)
X`009  If(I .ne. 0) Then
X`009    Ctopic = Ntopic - 1
X`009    If(Ctopic .gt. 0) Then
X`009`009Topics(Ctopic) = Record(I+1:Lrec)
X`009    `009Ltopics(Ctopic) = Min(Lrec - I,Len(Topics(1)))
X`009    Endif
X`009  Endif
X`009  Return
X
X`009Else If(Record(1:1) .ne. '/') Then
X`009  Return
X`009Endif
X*
X*`009New subtopic started by /. Continue at same subtopic level
X*
X`009Nsub = .True.
X
X`009If(Ctopic .gt. 0) Then
X`009`009Call Str$Trim(Record,Record,Lrec)`009!Dump trailing spaces
X`009`009Topics(Ctopic) = Record(1:Lrec)
X`009    `009Ltopics(Ctopic) = Lrec
X`009Endif
X
X`009Return
X`009End
$ CALL UNPACK SEARCH_MODULE.FOR;78 1159534348
$ create/nolog 'f'
X*
X*`009This file contains routines called at the end of each module,
X*`009each file, and at the end of everything, to do any logging necessary
X*`009and to accumulate statistics.
X*
X`009Subroutine Module_End(Module)
X`009Implicit None
X`009Character*(*) Module
X
X`009Include 'STATCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Include '($LBRDEF)'
X`009Include 'FILCOM.INC'
X
X`009External LIBSEARCH_MATCHEDMOD,LIBSEARCH_NOMATCHMOD
X*-------------------------------------------------------------------------
X*
X*`009Accumulate file-level statistics
X*
X`009Frec = Frec + Recs
X`009FMatch = Fmatch + Matches
X`009If(Matches .ne. 0) FmodMatch = FmodMatch + 1
X`009Fmod = Fmod + 1
X*
X*`009Report if necessary
X*
X`009If(Log) Then
X`009`009If(Matches .ne. 0) Then
X`009`009  Call Lib$Signal(LIBSEARCH_MATCHEDMOD,
X     $                          %val(3),Module,%val(Recs),%Val(Matches))
X`009`009Else
X`009`009  Call Lib$Signal(LIBSEARCH_NOMATCHMOD,
X     $                          %val(2),Module,%val(Recs))
X`009`009Endif
X`009Endif
X*
X*`009Zero statistics for next module
X*
X`009Recs = 0
X`009Matches = 0
X`009Return
X`009End
X
X
X`009Subroutine File_End(Fstat)
X`009Implicit None
X`009Integer FSTAT
X
X`009Include 'STATCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Include '($LBRDEF)'
X`009Include 'FILCOM.INC'
X
X`009External LIBSEARCH_MATCHED,LIBSEARCH_NOMATCH
X*-------------------------------------------------------------------------
X*
X*`009Accumulate overall statistics
X*
X`009Totrec = Totrec + Frec
X`009Totmat = Totmat + Fmatch
X`009TotMod = TotMod + Fmod
X`009Totfil = Totfil + 1
X*
X*`009We are passed the status code from Lib$get_Index.
X*`009Two status codes may need reporting on - NoMATCHFOU, and
X*`009NULIDX. One indicates that there are no matches, the other that
X*`009the library is empty.
X*
X*`009Report if necessary
X*
X`009If(Log) Then
X`009`009If(Fmodmatch .ne. 0) Then
X`009`009  Call Lib$Signal(LIBSEARCH_MATCHED,
X     $                          %val(5),Current_File(1:Cfilnaml),
X     $    %Val(Fmod),%Val(Fmodmatch),%Val(FRec),%Val(FMatch))
X`009`009Else
X*
X*`009Check status codes when there is no match
X*
X`009`009  Call Lib$Signal(LIBSEARCH_NOMATCH,
X     $                          %val(3),Current_File(1:Cfilnaml),
X     $                                  %Val(Fmod),%Val(FRec))
X`009`009Endif
X`009Endif
X*
X*`009Zero statistics for next file
X*
X`009FRec = 0
X`009Fmod = 0
X`009Fmatch = 0
X`009Fmodmatch = 0
X`009Return
X`009End
X
X`009Subroutine Stat_Rep
X*
X*`009Do final statistics reporting, and any other cleanup necessary.
X*
X`009Implicit None
X`009Include 'STATCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Character*(*) Fmt1,Fmt2
X`009Parameter (Fmt1 = '(1X,A,T22,I13,T41,A,T61,I10)')
X`009Parameter (Fmt2 = '(1X,A,T22,I13,T41,A,T58,A)')
X`009Character*17 CPU,Elapsed
X`009Character*20 Criteria
X`009Integer PF,Bio,Dio,Tl
X`009Integer Tims,Time(2)
X`009Integer Lib$Stat_Timer,Lib$Sys_Asctim,Status
X`009External LIBSEARCH_NOMATCHALL,LIBSEARCH_NOFILES
X`009Character*4 Match_type(0:3) /'OR','AND','NAND','NOR'/
X*
X*`009If no files, signal error
X*
X`009If(Totfil .eq. 0) Then
X`009`009Call Lib$Signal(LIBSEARCH_NOFILES)
X*
X*`009If no matches, always report this.
X*
X`009Else If(TotMat .eq. 0) Then
X`009  Call Lib$Signal(LIBSEARCH_NOMATCHALL)
X`009Endif
X
X`009If(.Not.Statistics) Return
X*
X*`009They want statistics. Produce a picture like this:
X*
X*Files searched:                 6       Buffered I/O count:        15
X*Modules searched:              20       Match Criteria:     /MATCH=AND/NOEX
VACT
X*Records searched:             646       Direct I/O count:           8
X*Characters searched:        14424       Page faults:               47
X*Records matched:                0       Elapsed CPU time:  0 00:00:00.87
X*Lines printed:                  0       Elapsed time:      0 00:00:01.45
X*
X`009Status = Lib$Stat_Timer(3,Bio,Timctx)
X`009Call StChek(Status)
X`009Status = Lib$Stat_Timer(4,Dio,Timctx)
X`009Call StChek(Status)
X`009Status = Lib$Stat_Timer(5,Pf,Timctx)
X`009Call StChek(Status)
X`009Status = Lib$Stat_Timer(2,Tims,Timctx)
X`009Call StChek(Status)
X`009Call Lib$Emul(Tims,-100 000,0,Time)
X`009Status = Lib$Sys_AscTim(Tl,CPU,Time,0)
X`009Call StChek(Status)
X`009Criteria = ' /MATCH='//Match_type(Match)
X`009If(Exact) Then
X`009`009Criteria(13:) ='/EXACT'
X`009Else
X`009`009Criteria(13:) ='/NOEXACT'
X`009Endif
X
X`009Write(*,Fmt1) 'Files searched:',Totfil,'Buffered I/O count:',Bio
X`009Write(*,Fmt2) 'Modules searched:',Totmod,'Match Criteria:',Criteria
X`009Write(*,Fmt1) 'Records searched:',Totrec,'Direct I/O count:',Dio
X`009Write(*,Fmt1) 'Characters searched:',TotChr,'Page faults:',Pf
X
X`009Write(*,Fmt2) 'Records matched:',TotMat,'Elapsed CPU time:',CPU
X
X`009Status = Lib$Stat_Timer(1,Time,Timctx)
X`009Call StChek(Status)
X`009Status = Lib$Sys_AscTim(Tl,Elapsed,Time,0)
X`009Call StChek(Status)
X`009Write(*,Fmt2) 'Lines printed:',Totout,'Elapsed time:',Elapsed
X`009Return
X`009End
X
X`009Subroutine Stat_Ini
X*
X*`009Initialize statistics
X*
X`009Implicit None
X`009Integer Status,Lib$Init_Timer
X`009Include 'STATCOM.INC'
X
X`009Totrec = 0
X`009Totfil = 0
X`009TotMod = 0
X`009TotChr = 0
+-+-+-+-+-+-+-+-  END  OF PART 4 +-+-+-+-+-+-+-+-

