Google
 

Trailing-Edge - PDP-10 Archives - BB-D875A-SM - 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