155 lines
5.5 KiB
Plaintext
Executable File
155 lines
5.5 KiB
Plaintext
Executable File
*******************************************************************************
|
|
*
|
|
* uniVerse PI/open -FINDFILE subroutine
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenance log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 02/24/93 11108 PVW Put in support for Multipart files.
|
|
* 12/07/92 10213 PVW Put in support for Q-pointers.
|
|
* 12/02/92 10213 PVW change to *UVPRINTMSG
|
|
* 11/12/92 10213 PVW Port PI/open ENTRO to uniVerse.
|
|
*
|
|
*******************************************************************************
|
|
|
|
$OPTIONS INFORMATION
|
|
|
|
SUBROUTINE FINDFILE (SENTENCE, SYMBOLS, ERROR.CODE)
|
|
|
|
$INCLUDE UNIVERSE.INCLUDE UV.COM
|
|
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
|
|
$INCLUDE UNIVERSE.INCLUDE SYMBOL.TBL.H
|
|
$INCLUDE UNIVERSE.INCLUDE KEYWORD.H
|
|
$INCLUDE UNIVERSE.INCLUDE VOC.TYPE.H
|
|
|
|
*---- Constants:
|
|
EQU DELIMITERS TO '+-*/^~=<>#(), '
|
|
POS = 0
|
|
ERROR.CODE = 0 ;*003
|
|
|
|
*---- Look for file name.
|
|
NUM.TOKENS = COUNT(SENTENCE, ' ') + 1
|
|
FOR I = 2 TO NUM.TOKENS ;* First token is VERB name.
|
|
TOKEN = FIELD(SENTENCE, ' ', I)
|
|
CC1 = COL1()
|
|
CC2 = COL2()
|
|
IF TOKEN = '' THEN GOTO NEXT.FILE.TOKEN
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, TOKEN ELSE
|
|
IF INDEX(TOKEN,",",1) THEN
|
|
MAIN.FILE = FIELD(TOKEN,",",1)
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, MAIN.FILE ELSE
|
|
TOKEN = UPCASE(TOKEN)
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, TOKEN ELSE
|
|
IF INDEX(TOKEN,",",1) THEN
|
|
MAIN.FILE = FIELD(TOKEN,",",1)
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, MAIN.FILE ELSE
|
|
GOTO NEXT.FILE.TOKEN
|
|
END
|
|
END ELSE
|
|
GOTO NEXT.FILE.TOKEN
|
|
END
|
|
END
|
|
END
|
|
END ELSE
|
|
TOKEN = UPCASE(TOKEN)
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, TOKEN ELSE
|
|
GOTO NEXT.FILE.TOKEN
|
|
END
|
|
END
|
|
END
|
|
|
|
TOKEN.TYPE = EXTRACT(WORD.DEF, 1, 0, 0) [1,1]
|
|
|
|
IF TOKEN.TYPE = VOC$KEYWORD AND EXTRACT(WORD.DEF, 2, 0, 0) = KW$DICT THEN
|
|
DEVSYS.DICT.SWITCH = 1
|
|
SYMBOL.VALUE = KEYWORD
|
|
SYMBOL.ORIGIN = 0 ;*007
|
|
GOSUB LSYMBOL
|
|
SYMBOLS(POS) = EXTRACT(WORD.DEF, 2, 0, 0)
|
|
SENTENCE = SENTENCE [1, CC1]:CHAR(KEYWORD):POS:SENTENCE [CC2, 999]
|
|
GOTO NEXT.FILE.TOKEN
|
|
END
|
|
|
|
IF TOKEN.TYPE = VOC$QPTR.FILE THEN
|
|
TOKEN.TYPE = VOC$FILE
|
|
WORD.DEF = 'F'
|
|
OPENCHECK '',TOKEN TO QPTR.DATA THEN
|
|
STATUS FILE.INFO FROM QPTR.DATA THEN
|
|
WORD.DEF<2> = FILE.INFO<20>
|
|
END ELSE
|
|
WORD.DEF<2> = ''
|
|
END
|
|
OPENCHECK 'DICT',TOKEN TO QPTR.DICT THEN
|
|
STATUS FILE.INFO FROM QPTR.DICT THEN
|
|
WORD.DEF<3> = FILE.INFO<20>
|
|
END ELSE
|
|
WORD.DEF<3> = ''
|
|
END
|
|
CLOSE QPTR.DICT
|
|
END ELSE
|
|
WORD.DEF<3> = ''
|
|
END
|
|
CLOSE QPTR.DATA
|
|
END ELSE
|
|
WORD.DEF<2> = ''
|
|
END
|
|
END
|
|
|
|
IF TOKEN.TYPE = VOC$FILE THEN
|
|
|
|
DEVSYS.FILE.FOUND = 1
|
|
|
|
*---- Found first file definition record.
|
|
SYMBOL.VALUE = FILE
|
|
SYMBOL.ORIGIN = 0 ;*007
|
|
GOSUB LSYMBOL
|
|
SYMBOLS(POS) = FIELD(WORD.DEF, @FM, 2, 4)
|
|
SENTENCE = SENTENCE [1, CC1]:CHAR(FILE):POS:SENTENCE [CC2, 999]
|
|
IF DEVSYS.DICT.SWITCH THEN
|
|
IF DEVSYS.DICT.FILE.NAME # 'DICT.DICT' THEN
|
|
DEVSYS.DICT.FILE.NAME = ''
|
|
OPENCHECK '', 'DICT.DICT' TO DEVSYS.DICT.FILE ELSE
|
|
CALL *UVPRINTMSG(001601,"DICT.DICT")
|
|
ERROR.CODE = 1
|
|
RETURN
|
|
END
|
|
DEVSYS.DICT.FILE.NAME = 'DICT.DICT'
|
|
END
|
|
END ELSE
|
|
IF DEVSYS.DICT.FILE.NAME # WORD.DEF<3> THEN
|
|
DEVSYS.DICT.FILE.NAME = ''
|
|
OPENCHECK 'DICT', TOKEN TO DEVSYS.DICT.FILE ELSE
|
|
CALL *UVPRINTMSG(001601,"DICT ":TOKEN)
|
|
ERROR.CODE = 2
|
|
RETURN
|
|
END
|
|
DEVSYS.DICT.FILE.NAME = WORD.DEF<3>
|
|
END ELSE
|
|
IF WORD.DEF<3> = '' THEN
|
|
CALL *UVPRINTMSG(001601,"DICT ":TOKEN)
|
|
ERROR.CODE = 2
|
|
RETURN
|
|
END
|
|
END
|
|
END
|
|
RETURN
|
|
END
|
|
|
|
NEXT.FILE.TOKEN:
|
|
NEXT I
|
|
RETURN
|
|
|
|
$INCLUDE UNIVERSE.INCLUDE SYMBOLINS.H
|
|
|
|
END
|