312 lines
11 KiB
Plaintext
312 lines
11 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* uniVerse port of PI/open EXPAND 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.
|
||
|
|
* 07/13/95 16907 EAP Use UNISEQ() for NLS support
|
||
|
|
* 11/07/94 15265 WLG Put back the () for PICK style COPY.
|
||
|
|
* 11/02/94 13261 WLG Removed DELIMITIERS except for space because there
|
||
|
|
* isn't any reason why a record-id can't contain:
|
||
|
|
* "+^~=<>()" in either PI or the old UV copy
|
||
|
|
* 07/19/94 13949 WLG Don't throw away id's which are in VOC as "K 38"
|
||
|
|
* to allow the caller to process them as valid ids.
|
||
|
|
* 08/04/93 10871 WLG Fix to handle COPY commandline allowing use
|
||
|
|
* of "-", and "#" in record-id and retaining the
|
||
|
|
* support for -OPTIONs on commandline.
|
||
|
|
* 01/29/93 10957 PVW allow dictionary names the same as filesname in
|
||
|
|
* revise
|
||
|
|
* 11/12/92 10213 PVW Port PI/open ENTRO to uniVerse.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$OPTIONS INFORMATION
|
||
|
|
|
||
|
|
SUBROUTINE EXPAND (SENTENCE, OUTLINE, SYMBOLS, ERROR.CODE)
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE UV.COM
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE SYMBOL.TBL.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE KEYWORD.H
|
||
|
|
|
||
|
|
EQU ITEM.TYPES TO 'PKDFVIRQAS'
|
||
|
|
|
||
|
|
STRIPSTRINGS = '-STRIPSTRINGS'
|
||
|
|
EXPAND = '-EXPAND'
|
||
|
|
FINDFILE = '-FINDFILE'
|
||
|
|
|
||
|
|
* Watch out for SYMBOLINS.H below!!!
|
||
|
|
|
||
|
|
EQU TYPE.DEF LIT 'INDEX(ITEM.TYPES, WORD.DEF [1, 1], 1) + 1'
|
||
|
|
|
||
|
|
*---- Constants:
|
||
|
|
|
||
|
|
* --- Moved the comma from DELIMITERS to ALTDELIM to support multi-level
|
||
|
|
* files and qpointers to multi-level files.
|
||
|
|
|
||
|
|
EQU DELIMITERS TO '() '
|
||
|
|
EQU ALTDELIM TO ',,'
|
||
|
|
MAX.TOKENS = 100
|
||
|
|
DIM TABLE (MAX.TOKENS, 2)
|
||
|
|
ALTSIZE = 20
|
||
|
|
DIM ALTTABLE (ALTSIZE, 2)
|
||
|
|
POS = 0
|
||
|
|
ERROR.CODE = 0 ;*004
|
||
|
|
|
||
|
|
|
||
|
|
MATPARSE:
|
||
|
|
MATPARSE TABLE FROM SENTENCE, DELIMITERS
|
||
|
|
IF INMAT() = 0 THEN
|
||
|
|
MAX.TOKENS = INT(MAX.TOKENS * 1.5)
|
||
|
|
DIM TABLE (MAX.TOKENS, 2)
|
||
|
|
GOTO MATPARSE
|
||
|
|
END
|
||
|
|
NUM.TOKENS = INT((INMAT() + 1) / 2)
|
||
|
|
|
||
|
|
*---- Perform expansion and lexical analysis.
|
||
|
|
FOR I = 1 TO NUM.TOKENS
|
||
|
|
|
||
|
|
DO.TOKEN:
|
||
|
|
TOKEN = TABLE (I, 1)
|
||
|
|
SYMBOL.ORIGIN = 0 ;* 0 = Neither ;*006
|
||
|
|
IF TOKEN = '' THEN GOTO NEXT.TOKEN
|
||
|
|
IF UNISEQ(TOKEN [1, 1]) <= MAX.TYPE THEN
|
||
|
|
OUTLINE := ' ':TOKEN
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
END
|
||
|
|
IF (NUM(TOKEN)) THEN GOTO IS.VAL
|
||
|
|
|
||
|
|
MATCH.DONE:
|
||
|
|
IF NOT(DEVSYS.FILE.FOUND) THEN GOTO SKIP.DICT
|
||
|
|
SYMBOL.ORIGIN = 1 ;* = DICT of data file ;*006
|
||
|
|
READ WORD.DEF FROM DEVSYS.DICT.FILE, TOKEN THEN
|
||
|
|
TOKEN.COUNT = DCOUNT(OUTLINE," ")
|
||
|
|
TOKEN.CHECK = FIELD(OUTLINE," ",TOKEN.COUNT)
|
||
|
|
SNO = TOKEN.CHECK[2,99]
|
||
|
|
|
||
|
|
IF UNISEQ(TOKEN.CHECK[1,1]) = KEYWORD THEN
|
||
|
|
OP.CODE = SYMBOLS(SNO)<1>
|
||
|
|
|
||
|
|
IF OP.CODE = KW$VERIFILE THEN
|
||
|
|
READ CHECK.DEF FROM DEVSYS.VOC.FILE, TOKEN THEN
|
||
|
|
SYMBOL.ORIGIN = 2
|
||
|
|
WORD.DEF = CHECK.DEF
|
||
|
|
END ELSE
|
||
|
|
IF INDEX(TOKEN,",",1) THEN
|
||
|
|
MAINFILE = FIELD(TOKEN,",",1)
|
||
|
|
READ CHECK.DEF FROM DEVSYS.VOC.FILE,MAINFILE THEN
|
||
|
|
SYMBOL.ORIGIN = 2
|
||
|
|
WORD.DEF = CHECK.DEF
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOTO DISPATCH
|
||
|
|
END ELSE
|
||
|
|
SKIP.DICT:
|
||
|
|
SYMBOL.ORIGIN = 2 ;* 2 = VOC ;*006
|
||
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, TOKEN ELSE
|
||
|
|
|
||
|
|
* --- Could be a filename with a comma in it (mainfile,mainfile
|
||
|
|
* or qpointer to a multi-level file), in which case it won't
|
||
|
|
* have a VOC entry for the filename. Use the part before the
|
||
|
|
* comma to read the VOC. If this exists in the VOC then this
|
||
|
|
* can be set as a file type.
|
||
|
|
IF INDEX(TOKEN, "," ,1) THEN
|
||
|
|
MAINFILE = FIELD(TOKEN, "," ,1)
|
||
|
|
READ WORD.DEF FROM DEVSYS.VOC.FILE, MAINFILE THEN GOTO DISPATCH
|
||
|
|
END
|
||
|
|
SYMBOL.ORIGIN = 0 ;* failed ;*006
|
||
|
|
IF TOKEN[1,1] = "-" OR INDEX(TOKEN, ',', 1) THEN
|
||
|
|
|
||
|
|
DELIM.TO.CHECK = ALTDELIM
|
||
|
|
IF TOKEN[1,1] = "-" AND NOT(INDEX(TOKEN, ',', 1)) THEN
|
||
|
|
READ OPT.REC FROM DEVSYS.VOC.FILE, TOKEN[2,999] THEN
|
||
|
|
IF OPT.REC[1,1] # "K" THEN GOTO IS.VAL
|
||
|
|
* We have an -OPTION which needs to be parsed
|
||
|
|
DELIM.TO.CHECK = "--"
|
||
|
|
END ELSE GOTO IS.VAL
|
||
|
|
END
|
||
|
|
ALTPARSE:
|
||
|
|
MATPARSE ALTTABLE FROM TOKEN, DELIM.TO.CHECK
|
||
|
|
IF INMAT() = 0 THEN
|
||
|
|
ALTSIZE = INT(ALTSIZE * 1.5)
|
||
|
|
DIM ALTTABLE (ALTSIZE, 2)
|
||
|
|
GOTO ALTPARSE
|
||
|
|
END
|
||
|
|
NUM.NEW = INT((INMAT() + 1) / 2)
|
||
|
|
|
||
|
|
*---- Check for table overflow.
|
||
|
|
IF NUM.NEW + NUM.TOKENS > MAX.TOKENS THEN
|
||
|
|
MAX.TOKENS = NUM.NEW * 2 + MAX.TOKENS
|
||
|
|
DIM TABLE (MAX.TOKENS, 2)
|
||
|
|
END
|
||
|
|
IF I < NUM.TOKENS THEN
|
||
|
|
*
|
||
|
|
* Move the rest of the existing tokens across to make space for the new ones
|
||
|
|
*
|
||
|
|
FOR J = NUM.TOKENS TO I + 1 STEP -1
|
||
|
|
J1 = J + NUM.NEW
|
||
|
|
TABLE (J1, 1) = TABLE (J, 1)
|
||
|
|
TABLE (J1, 2) = TABLE (J, 2)
|
||
|
|
NEXT J
|
||
|
|
END
|
||
|
|
*
|
||
|
|
* Now move the last delimiter entry to the end of the new block
|
||
|
|
*
|
||
|
|
TABLE (I+NUM.NEW, 1) = ''
|
||
|
|
TABLE (I+NUM.NEW, 2) = TABLE (I, 2)
|
||
|
|
*
|
||
|
|
* Now move all the new tokens elements in
|
||
|
|
*
|
||
|
|
FOR J = 1 TO NUM.NEW
|
||
|
|
J1 = I + J - 1
|
||
|
|
TABLE (J1, 1) = ALTTABLE (J, 1)
|
||
|
|
TABLE (J1, 2) = ALTTABLE (J, 2)
|
||
|
|
NEXT J
|
||
|
|
NUM.TOKENS += NUM.NEW
|
||
|
|
GOTO DO.TOKEN
|
||
|
|
END
|
||
|
|
|
||
|
|
IS.VAL:
|
||
|
|
SYMBOL.VALUE = VALUE
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
OUTLINE := ' ':CHAR(VALUE):POS
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Dispatch on symbol type.
|
||
|
|
DISPATCH:
|
||
|
|
ON TYPE.DEF GOTO DOBAD.TYPE, DOMACRO, DOKEYWORD,
|
||
|
|
D.TYPE.DICTIONARY, DOFILE, DOVERB, I.TYPE.DICTIONARY, DOREMOTE, DOQPTR, A.TYPE.DICTIONARY, S.TYPE.DICTIONARY
|
||
|
|
|
||
|
|
DOBAD.TYPE:
|
||
|
|
SYMBOL.VALUE = BAD.TYPE
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
OUTLINE := ' ':CHAR(BAD.TYPE):POS
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
DOREMOTE:
|
||
|
|
REMOTE.FILE = EXTRACT(WORD.DEF, 2, 0, 0)
|
||
|
|
REMOTE.ITEM = EXTRACT(WORD.DEF, 3, 0, 0)
|
||
|
|
IF DEVSYS.R.FILE.NAME # REMOTE.FILE THEN
|
||
|
|
DEVSYS.R.FILE.NAME = ''
|
||
|
|
OPEN '', REMOTE.FILE TO DEVSYS.R.FILE ELSE
|
||
|
|
PRINT 'Cannot open remote file "':
|
||
|
|
PRINT REMOTE.FILE:'" defined by "':
|
||
|
|
PRINT TOKEN:'".'
|
||
|
|
GOTO DOBAD.TYPE
|
||
|
|
END
|
||
|
|
DEVSYS.R.FILE.NAME = REMOTE.FILE
|
||
|
|
END
|
||
|
|
READ BODY FROM DEVSYS.R.FILE, REMOTE.ITEM ELSE
|
||
|
|
PRINT 'Cannot open remote record "':
|
||
|
|
PRINT REMOTE.ITEM:'" defined by "':
|
||
|
|
PRINT TOKEN:'".'
|
||
|
|
GOTO DOBAD.TYPE
|
||
|
|
END
|
||
|
|
WORD.DEF = BODY
|
||
|
|
GOTO DISPATCH
|
||
|
|
|
||
|
|
DOMACRO:
|
||
|
|
IF WORD.DEF[2,1] <> 'H'
|
||
|
|
THEN GOTO DOBAD.TYPE ;* Make sure it IS a PHrase (002).
|
||
|
|
BODY = EXTRACT(WORD.DEF, 2, 0, 0)
|
||
|
|
FMC = 2
|
||
|
|
|
||
|
|
MORE.M:
|
||
|
|
IF BODY [LEN(BODY), 1] = '_' THEN
|
||
|
|
FMC += 1
|
||
|
|
BODY = BODY [1, LEN(BODY)-1]:' ':EXTRACT(WORD.DEF, FMC, 0, 0)
|
||
|
|
GOTO MORE.M
|
||
|
|
END
|
||
|
|
BODY = ILPROMPT(BODY)
|
||
|
|
CALL @STRIPSTRINGS (BODY, MAT SYMBOLS)
|
||
|
|
IF NOT(DEVSYS.FILE.FOUND) THEN
|
||
|
|
CALL @FINDFILE ('VERB ':BODY, MAT SYMBOLS, ERROR.CODE) ;*004
|
||
|
|
END
|
||
|
|
|
||
|
|
IF NOT(ERROR.CODE)
|
||
|
|
THEN
|
||
|
|
* --- Only recurse if no error has occurred (SPAR 4034265).
|
||
|
|
CALL @EXPAND (BODY, OUTLINE, MAT SYMBOLS, ERROR.CODE)
|
||
|
|
END
|
||
|
|
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
DOKEYWORD:
|
||
|
|
SYMBOL.VALUE = KEYWORD
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
OUTLINE := ' ':CHAR(KEYWORD):POS
|
||
|
|
SYMBOLS (POS) = EXTRACT(WORD.DEF, 2, 0, 0)
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
A.TYPE.DICTIONARY:
|
||
|
|
S.TYPE.DICTIONARY:
|
||
|
|
D.TYPE.DICTIONARY:
|
||
|
|
SYMBOL.VALUE = NOUN
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
OUTLINE := ' ':CHAR(NOUN):POS
|
||
|
|
* include dictionary type in SYMBOLS table
|
||
|
|
SYMBOLS (POS) = WORD.DEF[1,1]:@FM:FIELD(WORD.DEF, @FM, 2, 999)
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
I.TYPE.DICTIONARY:
|
||
|
|
SYMBOL.VALUE = I.TYPE
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
OUTLINE := ' ':CHAR(I.TYPE):POS
|
||
|
|
SYMBOLS (POS) = FIELD(WORD.DEF, @FM, 2, 999)
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
* --- If the voc type was a qpointer then set this up as a file type. It will
|
||
|
|
* get resolved as a file when the file is opened within the verb.
|
||
|
|
DOQPTR:
|
||
|
|
DOFILE:
|
||
|
|
SYMBOL.VALUE = FILE
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
SYMBOLS (POS) = FIELD(WORD.DEF, @FM, 2, 4)
|
||
|
|
OUTLINE := ' ':CHAR(FILE):POS
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
DOVERB:
|
||
|
|
SYMBOL.VALUE = VERB
|
||
|
|
GOSUB LSYMBOL
|
||
|
|
SYMBOLS (POS) = FIELD(WORD.DEF, @FM, 2, 20)
|
||
|
|
OUTLINE := ' ':CHAR(VERB):POS
|
||
|
|
GOTO NEXT.TOKEN
|
||
|
|
|
||
|
|
NEXT.TOKEN:
|
||
|
|
TABLE (I, 2) = TRIM(TABLE (I, 2))
|
||
|
|
IF LEN(TABLE (I, 2)) = 1 THEN
|
||
|
|
OUTLINE := ' ':TABLE (I, 2)
|
||
|
|
END ELSE
|
||
|
|
J = 1
|
||
|
|
LOOP
|
||
|
|
UNTIL TABLE (I, 2) [J, 1] = '' DO
|
||
|
|
OUTLINE := ' ':TABLE (I, 2) [J, 1]
|
||
|
|
J += 1
|
||
|
|
REPEAT
|
||
|
|
END
|
||
|
|
NEXT I
|
||
|
|
CONVERT CHAR(9) TO @VM IN OUTLINE
|
||
|
|
OUTLINE = TRIM(OUTLINE)
|
||
|
|
CONVERT @VM TO CHAR(9) IN OUTLINE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE SYMBOLINS.H
|
||
|
|
|
||
|
|
END
|