372 lines
13 KiB
Plaintext
Executable File
372 lines
13 KiB
Plaintext
Executable File
SUBROUTINE PRECOMP.SUB(PRECOMP.FILENAME, SRC.FILENAME, DEST.FILENAME, ITEMNAME, RESULTS)
|
|
*******************************************************************************
|
|
*
|
|
*
|
|
* Server subroutine for PICK Account Conversion Toolkit
|
|
*
|
|
*
|
|
* 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.
|
|
*
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
*
|
|
* Maintenence log - insert most recent change descriptions at top
|
|
*
|
|
*
|
|
* Date.... GTAR# WHO Description........................................
|
|
* 06/10/99 25437 TGS Added line to retain orginial line and add
|
|
* comment lines to show begining and end of
|
|
* changed code.
|
|
* 06/17/99 25437 TGS Added line to prevent FUNCTION translation from
|
|
* going past the end of the program.
|
|
* 05/01/99 24567 DJD Added fixes from monolith
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 01/01/98 22758 CJA Initial release
|
|
* 03/16/98 22758 CJA Fixed problem replacing tokens within quotes.
|
|
************************************************************************
|
|
|
|
*
|
|
* DESCRIPTION:
|
|
|
|
*
|
|
************************************************************************
|
|
|
|
$INCLUDE UNIVERSE.INCLUDE PACTERR.H
|
|
|
|
EQU AM TO CHAR(254)
|
|
EQU VM TO CHAR(253)
|
|
EQU TRUE TO 1
|
|
EQU FALSE TO 0
|
|
|
|
*
|
|
OPENPATH PRECOMP.FILENAME TO F.PRECOMP ELSE
|
|
RESULTS = EADM.CANTOPENPRECOMP
|
|
RETURN
|
|
END
|
|
|
|
*
|
|
OPEN SRC.FILENAME TO F.SOURCE ELSE
|
|
RESULTS = EADM.CANTOPENSRC
|
|
RETURN
|
|
END
|
|
OPEN DEST.FILENAME TO F.DEST ELSE
|
|
RESULTS = EADM.CANTOPENDEST
|
|
RETURN
|
|
END
|
|
READ PROGRAM FROM F.SOURCE,ITEMNAME ELSE
|
|
RESULTS = EADM.CANTREAD
|
|
RETURN
|
|
END
|
|
|
|
*
|
|
COMMENT.LINE = "* The following line was converted by PACT."
|
|
CONVERT.COMMENT.START = "* Begin PACT converted line(s)."
|
|
CONVERT.COMMENT.END = "* End PACT converted line(s)."
|
|
NEWPROGRAM = ""
|
|
NO.LINES = DCOUNT(PROGRAM,AM)
|
|
FOR I.LINE = 1 TO NO.LINES
|
|
LINE = PROGRAM<I.LINE>
|
|
ORIG.LINE = LINE
|
|
IF TRIM(LINE)[1,1] = "*" THEN
|
|
NEWLINE = LINE
|
|
END ELSE
|
|
DELIMS = "()=+-\, ;:"
|
|
DONE = 0
|
|
I.CHAR = 0
|
|
L.COUNT = 0
|
|
MULTI.LINE = FALSE
|
|
LOOP UNTIL DONE OR L.COUNT > 6 DO
|
|
L.COUNT = L.COUNT + 1
|
|
DONE = 1
|
|
NEWLINE = ""
|
|
PAREN.COUNT = 0
|
|
QUOTE = FALSE
|
|
LOOP UNTIL LINE = "" OR (I.CHAR > LEN(LINE)) DO
|
|
I.CHAR = I.CHAR + 1
|
|
TEST = LINE[I.CHAR,1]
|
|
IF TEST = '(' THEN
|
|
PAREN.COUNT = PAREN.COUNT + 1
|
|
END
|
|
IF TEST = '"' OR TEST = "'" THEN
|
|
IF QUOTE = FALSE THEN
|
|
IF TEST = "'" THEN
|
|
QUOTE = TRUE
|
|
END ELSE QUOTE = 2
|
|
END ELSE
|
|
IF QUOTE = TRUE AND TEST = "'" THEN
|
|
QUOTE = FALSE
|
|
END
|
|
IF QUOTE = 2 AND TEST = '"' THEN
|
|
QUOTE = FALSE
|
|
END
|
|
END
|
|
END
|
|
IF INDEX(DELIMS,TEST,1) AND QUOTE = FALSE THEN
|
|
TOKEN = LINE[1,I.CHAR-1]
|
|
LINE = LINE[I.CHAR+1,LEN(LINE)]
|
|
ID.PRECOMP = TRIM(TOKEN)
|
|
IF TOKEN[1,1] = " " THEN B.SPC = " " ELSE B.SPC = ""
|
|
IF TOKEN[1,LEN(TOKEN)] = " " THEN A.SPC = " " ELSE A.SPC = ""
|
|
READ PRECOMP FROM F.PRECOMP,ID.PRECOMP THEN
|
|
DONE = 0
|
|
GOSUB 100
|
|
IF MULTI.LINE = FALSE THEN
|
|
TOKEN = B.SPC:TOKEN:A.SPC
|
|
END ELSE
|
|
NEWLINE = TOKEN:AM:NEWLINE
|
|
TOKEN = B.SPC:PRECOMP<2>:A.SPC
|
|
END
|
|
END ELSE
|
|
TOKEN = TOKEN:TEST
|
|
END
|
|
NEWLINE = NEWLINE:TOKEN
|
|
I.CHAR = 0
|
|
*
|
|
* Need to check and omitt comments
|
|
* Once an '*' is found UV Compiler
|
|
* ignores the rest of the line.
|
|
* By Wadah Sayyed
|
|
*
|
|
IF TEST = ";" THEN
|
|
GOT.COMMENT = FALSE
|
|
DONE.COMMENT = FALSE
|
|
COMMENT.LEN = 0
|
|
FOR I = 1 TO LEN(LINE) UNTIL (GOT.COMMENT OR DONE.COMMENT)
|
|
BEGIN CASE
|
|
CASE LINE[I,1] = '*'
|
|
GOT.COMMENT = TRUE
|
|
CASE ( LINE[I,1] # ' ' )
|
|
DONE.COMMENT = TRUE
|
|
CASE 1
|
|
END CASE
|
|
NEXT I
|
|
IF GOT.COMMENT THEN I.CHAR = I.CHAR + LEN(LINE)
|
|
END
|
|
END
|
|
REPEAT
|
|
LINE = NEWLINE
|
|
REPEAT
|
|
END
|
|
* If what I have is not the same as what I started out with
|
|
* then there was a change.
|
|
* Add comments to the orginial line.
|
|
* Place comments in the program that PACT has changed the line
|
|
* Also add code which shows the begining and end of
|
|
* the replacement lines.
|
|
IF NEWLINE # ORIG.LINE THEN
|
|
NEWPROGRAM<-1> = COMMENT.LINE
|
|
NEWPROGRAM<-1> = "*":ORIG.LINE
|
|
NEWPROGRAM<-1> = CONVERT.COMMENT.START:AM:NEWLINE:AM:CONVERT.COMMENT.END
|
|
END ELSE
|
|
NEWPROGRAM<-1> = NEWLINE
|
|
END
|
|
CRT '.':
|
|
NEXT I.LINE
|
|
CRT
|
|
|
|
*
|
|
RESULTS = 0
|
|
WRITE NEWPROGRAM ON F.DEST,ITEMNAME
|
|
|
|
*
|
|
RETURN
|
|
|
|
*
|
|
* Extract Token
|
|
* Routine to extract syntax for token
|
|
|
|
*
|
|
100: NO.PARENS = DCOUNT(LINE,"(")
|
|
END.PAREN = NO.PARENS - (PAREN.COUNT - 1)
|
|
STRING = LINE
|
|
END.POS = 0
|
|
PARAMS = ""
|
|
NO.PARENS = 0
|
|
I.CHR = 0
|
|
LOOP UNTIL STRING = "" OR NO.PARENS < 0 DO
|
|
END.POS = END.POS + 1
|
|
I.CHR = I.CHR + 1
|
|
TEST.CHR = STRING[I.CHR,1]
|
|
BEGIN CASE
|
|
CASE TEST.CHR = '('
|
|
NO.PARENS = NO.PARENS + 1
|
|
CASE TEST.CHR = ')'
|
|
NO.PARENS = NO.PARENS - 1
|
|
IF NO.PARENS = -1 THEN
|
|
PARAMS<-1> = STRING[1,I.CHR-1]
|
|
STRING = ""
|
|
END
|
|
CASE TEST.CHR = ',' AND NO.PARENS = 0
|
|
PARAMS<-1> = STRING[1,I.CHR - 1]
|
|
STRING = STRING[I.CHR+1,LEN(STRING)]
|
|
I.CHR = 0
|
|
CASE TEST.CHR = ""
|
|
PARAMS<-1> = STRING
|
|
STRING = ""
|
|
END CASE
|
|
REPEAT
|
|
|
|
*
|
|
NO.CONDITIONS = DCOUNT(PRECOMP<1>,VM)
|
|
FOUND = FALSE
|
|
S.ATTR = 3
|
|
CNT = 0
|
|
LOOP
|
|
CNT = CNT + 1
|
|
CONDITION = PRECOMP<1,CNT>
|
|
UNTIL CNT > NO.CONDITIONS OR FOUND = TRUE DO
|
|
BEGIN CASE
|
|
CASE CONDITION = ""
|
|
S.ATTR = CNT + 2
|
|
FOUND = TRUE
|
|
CASE NUM(CONDITION)
|
|
IF CONDITION = DCOUNT(PARAMS,AM) THEN
|
|
S.ATTR = CNT + 2
|
|
FOUND = TRUE
|
|
END
|
|
*
|
|
* Added to handle functions from Mentor Pro
|
|
* By Wadah Sayyed
|
|
*
|
|
CASE CONDITION[1,1] = "F"
|
|
FUNCTION.ID = TRIM( FIELD(LINE, '(', 1) )
|
|
*
|
|
* How many arguments?
|
|
*
|
|
COMMENT.ONLY = ( PRECOMP<3>[1,1] = "*" )
|
|
ARG.LIST = ''
|
|
ARG.CNT = 0
|
|
START.POS = INDEX(LINE, "(", 1)
|
|
IF START.POS THEN
|
|
START.POS = START.POS + 1
|
|
LAST.ARG = FALSE
|
|
CHR.CNT = START.POS - 1
|
|
NO.PARENS = 0
|
|
LAST.ARG = FALSE
|
|
LOOP
|
|
CHR.CNT = CHR.CNT + 1
|
|
TEST.CHR = LINE[CHR.CNT,1]
|
|
BEGIN CASE
|
|
CASE TEST.CHR = "("
|
|
NO.PARENS = NO.PARENS + 1
|
|
ARG.LIST = ARG.LIST:TEST.CHR
|
|
CASE TEST.CHR = ","
|
|
ARG.LIST = ARG.LIST:TEST.CHR
|
|
ARG.CNT = ARG.CNT + 1
|
|
CASE TEST.CHR = ")"
|
|
NO.PARENS = NO.PARENS - 1
|
|
IF NO.PARENS = "-1" THEN
|
|
LAST.ARG = TRUE
|
|
ARG.CNT = ARG.CNT + 1
|
|
END ELSE
|
|
ARG.LIST = ARG.LIST:TEST.CHR
|
|
END
|
|
CASE 1
|
|
ARG.LIST = ARG.LIST:TEST.CHR
|
|
END CASE
|
|
UNTIL (( LAST.ARG ) OR ( CHR.CNT = LEN(LINE) )) DO REPEAT
|
|
END ELSE CHR.CNT = LEN(FUNCTION.ID)
|
|
LEN.PROCESSED = CHR.CNT + 1
|
|
*
|
|
* 1. Comment out the function and leave it in the code
|
|
* for reference.
|
|
* 2. Structure the UV function
|
|
*
|
|
END.OF.FUNC = FALSE
|
|
FUNC.ITEM = "FUNCTION ":FUNCTION.ID:"(":TRIM(ARG.LIST):")"
|
|
* We are now commenting the lines out so this line is not needed
|
|
* NEWPROGRAM<-1> = "* ":TOKEN:" ":LINE
|
|
GOT.FUNC = FALSE
|
|
LOOP
|
|
I.LINE = I.LINE + 1
|
|
* Since we now comment lines out there is no need for this line
|
|
* If left in this will cause double lines.
|
|
* NEWPROGRAM<-1> = "* ":PROGRAM<I.LINE>
|
|
FUNC.LINE = TRIM(PROGRAM<I.LINE>)
|
|
IF FUNC.LINE[1,10] = "RETURNING " THEN
|
|
GOT.FUNC = TRUE
|
|
FUNC.LINE = "RETURN (":FUNC.LINE[11,999]:")"
|
|
END
|
|
FUNC.ITEM = FUNC.ITEM:AM:FUNC.LINE
|
|
* UNTIL GOT.FUNC DO REPEAT
|
|
* Changed by Tim Stokes.
|
|
* If the FUNCTION has been coded incorrectly then the
|
|
* Program will go into an infinte loop
|
|
UNTIL GOT.FUNC OR I.LINE > NO.LINES DO REPEAT
|
|
IF NOT(COMMENT.ONLY) THEN
|
|
WRITE FUNC.ITEM ON F.DEST,FUNCTION.ID
|
|
END
|
|
* This should trigger new definitions to handle
|
|
* using the function in the rest of the code,
|
|
* so, let's create it
|
|
NEW.PRECOMP.ID = "@":FUNCTION.ID
|
|
NEW.PRECOMP.ITEM = ''
|
|
NEW.PRECOMP.ITEM<1> = "@"
|
|
IF COMMENT.ONLY THEN
|
|
NEW.PRECOMP.ITEM<3> = "*"
|
|
END ELSE
|
|
NEW.PRECOMP.ITEM<3> = FUNCTION.ID:"("
|
|
FOR I = 1 TO ARG.CNT
|
|
NEW.PRECOMP.ITEM<3> = NEW.PRECOMP.ITEM<3> : "%%":I
|
|
IF I < ARG.CNT THEN NEW.PRECOMP.ITEM<3> = NEW.PRECOMP.ITEM<3> : ","
|
|
NEXT I
|
|
NEW.PRECOMP.ITEM<3> = NEW.PRECOMP.ITEM<3> : ")"
|
|
END
|
|
WRITE NEW.PRECOMP.ITEM ON F.PRECOMP, NEW.PRECOMP.ID
|
|
IF COMMENT.ONLY THEN
|
|
TOKEN = ''
|
|
END ELSE
|
|
PRECOMP = DELETE(PRECOMP,3)
|
|
TOKEN = "DEFFUN " : FUNCTION.ID
|
|
IF TRIM(ARG.LIST) # '' THEN TOKEN = TOKEN : "(" : TRIM(ARG.LIST) : ")"
|
|
END
|
|
LINE = LINE[LEN.PROCESSED,99]
|
|
CASE CONDITION[1,1] = "@"
|
|
CASE 1
|
|
ATTR = FIELD(CONDITION,',',1)
|
|
VALUE = FIELD(CONDITION,',',2)
|
|
IF TRIM(PARAMS<ATTR>) = VALUE THEN
|
|
S.ATTR = CNT + 2
|
|
FOUND = TRUE
|
|
END
|
|
END CASE
|
|
REPEAT
|
|
IF PRECOMP<S.ATTR> = "" THEN
|
|
TOKEN = TOKEN:TEST
|
|
RETURN
|
|
END
|
|
IF PRECOMP<S.ATTR> = "*" THEN
|
|
TOKEN = "* ":TOKEN:TEST
|
|
RETURN
|
|
END
|
|
LINE = LINE[END.POS+1,LEN(LINE)]
|
|
|
|
*
|
|
TOKEN = ""
|
|
AM.STRING = ""
|
|
MULTI.LINE = FALSE
|
|
NO.PRECOMP = DCOUNT(PRECOMP<S.ATTR>,VM)
|
|
FOR I.PRECOMP = 1 TO NO.PRECOMP
|
|
IF I.PRECOMP > 1 THEN
|
|
MULTI.LINE = TRUE
|
|
AM.STRING = AM
|
|
END
|
|
TOKEN = TOKEN:AM.STRING:PRECOMP<S.ATTR,I.PRECOMP>
|
|
NEXT I.PRECOMP
|
|
|
|
*
|
|
LOOP
|
|
POS = INDEX(TOKEN,"%%",1)
|
|
UNTIL POS = 0 DO
|
|
FIELD.NO = TOKEN[POS+2,1]
|
|
TOKEN = TOKEN[1,POS-1]:PARAMS<FIELD.NO>:TOKEN[POS+3,LEN(TOKEN)]
|
|
REPEAT
|
|
RETURN
|