******************************************************************************* * * 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