Trailing-Edge
-
PDP-10 Archives
-
bb-d857a-sm_dx_tops20_v1_src
-
dx/sources/lookup.for
There are 2 other files named lookup.for in the archive. Click here to see a list.
C PACKAGE : DX/TOPS20
C VERSION : V1.0
C OP. SYSTEM : TOPS20 V3.0
C MODULE : LOOKUP
C EDIT : 006
C EDIT DATE : 9-AUG-78
C
C PROGRAM : WPIP
C MODULE # : 10 OF 13
C PROGRAM : WLPT
C MODULE # : 12 OF 12
C PROGRAM : WFLX
C MODULE # : 15 OF 17
C PROGRAM : WNDX
C MODULE # : 2 OF 2
C PROGRAM : WDEL
C MODULE # : 2 OF 2
C
C
C
C**********************************************************************
C
C C O P Y R I G H T
C
C
C COPYRIGHT (C) 1978
C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
C
C
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
C SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR
C ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE
C MADE AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH
C SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO
C AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN
C DIGITAL.
C
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
C NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C EQUIPMENT CORPORATION.
C
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
C OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
C
C**********************************************************************
C
C
C E D I T H I S T O R Y
C
C
C EDIT #000 5/4/78 KENT BLACKETT
C INITIAL IMPLEMENTATION.
C
C EDIT #001 5/15/78 KENT BLACKETT
C CHANGE FILE SIZE TO ALLOW FOR 1000 RECORDS.
C
C EDIT #002 5/15/78 KENT BLACKETT
C CHANGE SUBSTRING MATCH ALGORITHM TO MATCH INTEGRAL "WORDS",
C NOT CHARACTERS. THIS MEANS WHEN WE MATCH A SUBSTRING OF A
C DOCUMENT NAME, WE INSIST THAT THE NEXT CHARACTER IN THE
C DOCUMENT NAME IN THE INDEX IS A SPACE CHARACTER. THIS MAKES
C THE LOOKUP ALGORITHM CONSISTENT WITH THE WPS-8 ONE.
C
C EDIT #003 5/17/78 KENT BLACKETT
C MAKE SURE THE USER CANNOT CALL ME WITH A DOCUMENT NUMBER
C GREATER THAN 999 OR EQUAL TO 1.
C
C EDIT #004 5/25/78 J. COHEN
C INFORM USER OF INABILITY TO DELETE A DOCUMENT DUE TO A
C PRIVILEGE VIOLATION OR A NON-EXISTENT DOCnnn FILE.
C
C EDIT #005 7/11/78 J. COHEN
C FIX SO THAT DOCUMENT NAME IS ELIMINATED WHEN
C DOCUMENT IS BEING DELETED.
C
C EDIT #006 8/9/78 J. COHEN
C ALTER SO THAT SECOND RECORD OF HEADER IS READ TO DETERMINE
C IF THE DOCUMENT WAS CREATED BY WFLX. ALSO IF THE DOCUMENT
C BEING READ IS #1, RETURN BEFORE ATTEMPTING TO READ THIS
C RECORD.
C
C
C**********************************************************************
C
C
C
C
C LOOKUP -- Lookup a named or numbered document in the Word Processing
C index, and return the operating system-acceptable file
C name, creation date, file size, etc.
C
SUBROUTINE LOOKUP(LUN,IDOCNO,DOCNAM,IDNLEN,IEXIST,CREDAT,
1 MODDAT,MODTIM,ISIZE,IVERSN,FILNAM,IFNLEN)
C
IMPLICIT INTEGER (A-Z)
DIMENSION DOCNAM(64),CREDAT(2),MODDAT(2),
1 NAME(64),CREATE(2),MODIF(2),BUF(80)
DIMENSION DMY(2),MONTHS(12)
DOUBLE PRECISION FILNAM,FNAME
DATA MONTHS/'Jan','Feb','Mar','Apr',
1 'May','Jun','Jul','Aug',
2 'Sep','Oct','Nov','Dec'/
C
C LUN = FORTRAN unit number of the disk.
C IDOCNO = The WPS document number. If IDOCNO <> 0 upon call, we just
C use the number for retreiving the file, not the name.
C DOCNAM = The 1 to 64 character WPS document name.
C IDNLEN = The length of the document name in DOCNAM.
C IEXIST = A flag returned by LOOKUP, with the following settings:
C 1 = means named (or numbered) document exists, all is well.
C 2 = means named (or numbered) document does not exist.
C 3 = means named (or numbered) document entry exists in
C WPS index, but corresponding file doesn't exist.
C This indicates someone manually deleted a file.
C 4 = means document name supplied is not unique.
C 5 = means named (or numbered) document exists and
C at some point was converted by 'WP8FLX'.
C CREDAT = The document creation date returned from header (MM/DD/YY).
C MODDAT = The last date the document was modified (MM/DD/YY).
C MODTIM = The time the document was last modified (HH:MM).
C ISIZE = The number of 512 byte blocks the file takes.
C IVERSN = The sequential document version number.
C FILNAM = The corresponding operating system-acceptable file name
C of the named (or numbered) document.
C IFNLEN = The number of characters in FILNAM.
C
OPEN(UNIT=LUN,DEVICE='DSK:',FILE='DOC001.W11',MODE='ASCII',
1 ERR=900,ACCESS='RANDOM',FILE SIZE=6860,RECORD SIZE=96)
50 READ(LUN'1, 100,ERR=900) IACTV,NAMLEN,NAME,CREATE,MODIF,MODIFT,
1 IBLKS, IVERSI
100 FORMAT(I1, I2, 64R1, 2(A5,A3), A5, I4, I4)
LSTDOC = IBLKS
FRSTFR = LSTDOC + 1
C
C DETERMINE IF WE ARE LOOKING UP A DOCUMENT BY NAME OR NUMBER
C
IF( IDOCNO .EQ. 0 ) GO TO 195
IF( IDOCNO .GT. 999) GO TO 257
IF( IDOCNO .GT. LSTDOC ) GO TO 251
READ(LUN'IDOCNO, 100,END=255,ERR=255) IACTV,NAMLEN,NAME,
1 CREATE,MODIF,MODIFT,IBLKS,IVERSI
FRSTFR = IDOCNO
MATCH = IDOCNO
IF( IACTV .EQ. 0 ) GO TO 255
GO TO 260
C
C SEARCH FOR NAMED DOCUMENT
C
195 MATCH = 0
DO 250 I=2,LSTDOC
C
C READ IN A DOCUMENT ENTRY, AND CHECK TO SEE IF THE ENTRY IS IN USE.
C
READ(LUN'I, 100,END=250,ERR=250) IACTV,NAMLEN,NAME,CREATE,
1 MODIF,MODIFT,IBLKS,IVERSI
IF( IACTV .EQ. 1 ) GO TO 200
C
C NO, ITS EMPTY, SO REMEMBER THIS FREE SLOT IN CASE WE ARE CREATING
C A NEW DOCUMENT.
C
IF( FRSTFR .EQ. LSTDOC + 1 ) FRSTFR = I
GO TO 250
C
C YES, THIS IS AN ACTIVE DOCUMENT ENTRY. DO THE FIRST "IDNLEN"
C CHARACTERS MATCH THE GIVEN DOCUMENT NAME?
C
200 DO 205 J = 1, IDNLEN
IF(NAME(J) .LT. "141 .OR. NAME(J) .GT. "172) GO TO 201
IT1 = NAME(J) .AND. "137
GO TO 202
201 IT1 = NAME(J)
202 IF(DOCNAM(J) .LT. "141 .OR. DOCNAM(J) .GT. "172) GO TO 203
IT2 = DOCNAM(J) .AND. "137
GO TO 204
203 IT2 = DOCNAM(J)
204 IF(IT1 .NE. IT2) GO TO 250
205 CONTINUE
C
C YES, THEY DO MATCH. THIS COULD BE MY DOCUMENT, OR AN AMBIGUOUS
C (THAT IS NOT LONG ENOUGH TO MAKE IT UNIQUE) NAME.
C
DO 210 J = IDNLEN+1, 64
IF( NAME(J) .NE. 32 ) GO TO 220
210 CONTINUE
C
C TURNS OUT TO BE THE COMPLETE DOCUMENT NAME, THE SEARCH IS OVER.
C
MATCH = I
GO TO 260
C
C WE FOUND A MATCH ON THE FIRST CHARACTERS OF THE NAME. THE RESULTS
C ARE NOT CONCLUSIVE. IF THE NEXT CHARACTER IS A SPACE, WE HAVE MA