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