      SUBROUTINE PC.1(PGM.FILE,PGM.ID,OBJ.NAME)
*PRE-COMPILER
*
*DEV TRIAL RT
*BASIC
*N
*     PRECISION 6
*
************************************************************************
************************************************************************
***                                                                  ***
*** PICK PARSING PRE-COMPILER SYSTEM                                 ***
***                                                                  ***
*** COPYRIGHT 1988 MODULAR SOFTWARE                                  ***
***                P.O. BOX 204                                      ***
***                ATLANTA, GA  30291                                ***
***                (404) 964 - 7171                                  ***
***                                                                  ***
*** THIS PROGRAM IS PROPRIETARY TO MODULAR SOFTWARE AND MAY NOT BE   ***
*** USED, COPIED, EXAMINED, OR DISCLOSED WITHOUT A VALID LICENSE     ***
*** FROM MODULAR SOFTWARE.                                           ***
***                                                                  ***
************************************************************************
************************************************************************
*
*
* Pre-compiler recursive compiler driver for a single item
*
*
      $INCLUDE PC.COMMON
*
      EQUATE SEP.CH TO CHAR(240)
*
      RECUR.LEVEL = RECUR.LEVEL + 1
      LINE.NO(RECUR.LEVEL) = ''
      LINE.OFF(RECUR.LEVEL) = 0
*
      IF RECUR.LEVEL = 1 THEN
         MAT DATA.ARRAY = ''
         SYNTAX.FILE = ''
         GOSUB 1000
*
         PC.FLG = YES
         ERROR = NO
         PREC.STR = ''
         CHAIN.FLG = 0
         INCL.NO = 0
      END
*
      OOBJ = ''
      OOBJ2 = ''
      CHAIN.ID = PGM.ID
*
      IF PGM.FILE <> '' THEN
         OPEN PGM.FILE TO SRC.FD ELSE STOP 201,PGM.FILE
      END
*
      LOOP
         READ DATA FROM SRC.FD , CHAIN.ID THEN
            CUR.PGM = CHAIN.ID
            CHAIN.FILE = ''
            CHAIN.ID = ''
*
            NO.LINES = DCOUNT(DATA,AM)
            BEGIN CASE
               CASE RECUR.LEVEL > 1 OR LEN(DATA) > 15000 OR NO.LINES > 1000
                  DATA = ''
*$*               FOR LINE.CNT(RECUR.LEVEL) = 1 TO NO.LINES UNTIL CHAIN.ID # '' OR ERROR
                  LINE.CNT(RECUR.LEVEL) = 1
                  LOOP WHILE LINE.CNT(RECUR.LEVEL) <= NO.LINES AND NOT(CHAIN.ID # '') AND NOT(ERROR) DO
                     READV OBJ FROM SRC.FD , CUR.PGM , LINE.CNT(RECUR.LEVEL) ELSE STOP 202,CUR.PGM
                     GOSUB 200
*$*               NEXT LINE.CNT(RECUR.LEVEL)
                     LINE.CNT(RECUR.LEVEL) = LINE.CNT(RECUR.LEVEL) + 1
                  REPEAT
               CASE YES
                  DATA = ''
                  MATREAD DATA.ARRAY FROM SRC.FD , CUR.PGM ELSE STOP 202,CUR.PGM
*$*               FOR LINE.CNT(RECUR.LEVEL) = 1 TO NO.LINES UNTIL CHAIN.ID # '' OR ERROR
                  LINE.CNT(RECUR.LEVEL) = 1
                  LOOP WHILE LINE.CNT(RECUR.LEVEL) <= NO.LINES AND NOT(CHAIN.ID # '') AND NOT(ERROR) DO
                     OBJ = DATA.ARRAY(LINE.CNT(RECUR.LEVEL))
                     GOSUB 200
*$*               NEXT LINE.CNT(RECUR.LEVEL)
                     LINE.CNT(RECUR.LEVEL) = LINE.CNT(RECUR.LEVEL) + 1
                  REPEAT
            END CASE
         END ELSE
            PRINT
            CALL PC.PRINT("*** Unable to read program '" : CHAIN.ID : "' ***")
            ERROR = YES
         END
      UNTIL CHAIN.ID = '' OR ERROR DO
         IF CHAIN.FILE <> '' THEN
            OPEN CHAIN.FILE TO SRC.FD ELSE STOP 201,CHAIN.FILE
         END
         LINE.OFF(RECUR.LEVEL) = LINE.CNT(RECUR.LEVEL) - 1
      REPEAT
*
      IF NOT(ERROR) THEN
         IF OOBJ <> '' OR OOBJ2 <> '' THEN
            OOBJ<-1> = OOBJ2
            IF CHAIN.FLG THEN
               WRITE OOBJ ON DEST.FD , 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
               INCL.NO = INCL.NO + 1
            END ELSE
               WRITE OOBJ ON DEST.FD , OBJ.NAME
            END
         END
         IF RECUR.LEVEL = 1 THEN
            IF C.STR <> '' THEN
               READV OBJ FROM DEST.FD , PGM.ID , 1 ELSE OBJ = ''
               IF OBJ[1,10] = 'SUBROUTINE' THEN
                  READV OBJ FROM DEST.FD , PGM.ID , 2 ELSE OBJ = ''
                  OBJ = C.STR : SEP.CH : OBJ
                  WRITEV OBJ ON DEST.FD , OBJ.NAME , 2
               END ELSE
                  IF I.STR <> '' THEN
                     OBJ = I.STR : SEP.CH : OBJ
                  END
                  OBJ = C.STR : SEP.CH : OBJ
                  WRITEV OBJ ON DEST.FD , OBJ.NAME , 1
               END
            END
            READV OBJ FROM DEST.FD , PGM.ID , 1 ELSE OBJ = ''
            IF INDEX(OBJ,CHAR(240),1) THEN
               INCL.ID = 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
               WRITEV CONVERT(CHAR(240),CHAR(254),OBJ) ON DEST.FD , INCL.ID , 1
               INCL.NO = INCL.NO + 1
               WRITEV INCLUDE.STR : ' ' : INCL.ID ON DEST.FD , PGM.ID , 1
            END
            READV OBJ FROM DEST.FD , PGM.ID , 2 ELSE OBJ = ''
            IF INDEX(OBJ,CHAR(240),1) THEN
               INCL.ID = 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
               WRITE CONVERT(CHAR(240),CHAR(254),OBJ) ON DEST.FD , INCL.ID
               INCL.NO = INCL.NO + 1
               WRITEV INCLUDE.STR : ' ' : INCL.ID ON DEST.FD , PGM.ID , 2
            END
         END
      END
*
      RECUR.LEVEL = RECUR.LEVEL - 1
*
      IF RECUR.LEVEL = 1 THEN
         IF NOT(MOD(LINE.NO(1),10)) THEN
            PRINT CR : LINE.NO(1) 'R#4' : SPACE(5) :
         END
      END
*
      RETURN
*
200 * PROCESS A LINE
*
      LINE.NO(RECUR.LEVEL) = LINE.CNT(RECUR.LEVEL) + LINE.OFF(RECUR.LEVEL)
*
      IF TRIM(OBJ) = '' THEN OBJ = '*'
      IF T.OPT THEN
          OBJ = OBJ<1,1,1>
       END ELSE
         OBJ = OBJ[INDEX(OBJ,TRIM(OBJ)[1,1],1),32000]
      END
      BEGIN CASE
         CASE OBJ[1,1] = '#'
            BEGIN CASE
               CASE OBJ[1,8] = '#DEFINE '
                  IF NOT(DEF.NEST.CNT) THEN
                     S = FIELD(OBJ,' ',2)
                     LOCATE S IN DEF.SYMBOLS<1> SETTING DUMMY ELSE
                        DEF.SYMBOLS<-1> = S
                     END
                     OBJ = '*' : OBJ
                  END ELSE
                     OBJ = '*### ' : OBJ
                  END
               CASE OBJ[1,10] = '#UNDEFINE '
                  IF NOT(DEF.NEST.CNT) THEN
                     S = FIELD(OBJ,' ',2)
                     LOCATE S IN DEF.SYMBOLS<1> SETTING L THEN
                        DEF.SYMBOLS = DELETE(DEF.SYMBOLS,L,0,0)
                     END
                     OBJ = '*' : OBJ
                  END ELSE
                     OBJ = '*### ' : OBJ
                  END
               CASE OBJ[1,4] = '#IF '
                  IF DEF.NEST.CNT THEN
                     DEF.NEST.CNT = DEF.NEST.CNT + 1
                     OBJ = '*### ' : OBJ
                  END ELSE
                     FLG = NO
                     S = FIELD(OBJ,' ',2)
                     FOR I = 1 TO DCOUNT(S,'|') UNTIL FLG
                        LOCATE FIELD(S,'|',I) IN DEF.SYMBOLS<1> SETTING DUMMY THEN
                           FLG = YES
                        END
                     NEXT I
                     IF NOT(FLG) THEN
                        DEF.NEST.CNT = DEF.NEST.CNT + 1
                        OBJ = '*### ' : OBJ
                     END ELSE
                        OBJ = '*' : OBJ
                     END
                  END
               CASE OBJ[1,5] = '#IFN '
                  IF DEF.NEST.CNT THEN
                     DEF.NEST.CNT = DEF.NEST.CNT + 1
                     OBJ = '*### ' : OBJ
                  END ELSE
                     FLG = NO
                     S = FIELD(OBJ,' ',2)
                     FOR I = 1 TO DCOUNT(S,'|') UNTIL FLG
                        LOCATE FIELD(S,'|',I) IN DEF.SYMBOLS<1> SETTING DUMMY THEN
                           FLG = YES
                        END
                     NEXT I
                     IF FLG THEN
                        DEF.NEST.CNT = DEF.NEST.CNT + 1
                        OBJ = '*### ' : OBJ
                     END ELSE
                        OBJ = '*' : OBJ
                     END
                  END
               CASE OBJ[1,4] = '#END'
                  IF DEF.NEST.CNT THEN
                     DEF.NEST.CNT = DEF.NEST.CNT - 1
                     OBJ = '*### ' : OBJ
                  END ELSE
                     OBJ = '*' : OBJ
                  END
            END CASE
         CASE DEF.NEST.CNT
            OBJ = '*### ' : OBJ
         CASE OBJ[1,4] = '*$PC'
            W = FIELD(OBJ,' ',2)
            BEGIN CASE
               CASE W = 'OFF'
                  PC.FLG = NO
               CASE W = 'ON'
                  PC.FLG = YES
               CASE W = 'SYNTAX'
                  SYNTAX.FILE = FIELD(OBJ,' ',3)
                  GOSUB 1000
            END CASE
         CASE OBJ[1,1] = '*'
            IF NOT(T.OPT) THEN
               OBJ = '*'
            END
         CASE OBJ[1,1] = '!'
            IF NOT(T.OPT) THEN
               OBJ = '*'
            END
         CASE OBJ[1,3] = 'REM'
            IF NOT(T.OPT) THEN
               OBJ = '*'
            END
         CASE TRIM(OBJ) = ''
            IF NOT(T.OPT) THEN
               OBJ = '*'
            END
         CASE TRIM(OBJ) MATCHES '1N0N REM'
            OBJ = FIELD(TRIM(OBJ),' ',1) : ' *'
         CASE NOT(PC.FLG)
         CASE YES
            IF Q.OPT THEN O.OBJ = OBJ
            IF INDEX(OBJ,'INCLUDE',1) OR INDEX(OBJ,'INSERT',1) OR INDEX(OBJ,'$CHAIN',1) THEN
               SAVE.SRC.FD = SRC.FD
               CALL PC.INCLUDE(OBJ)
               SRC.FD = SAVE.SRC.FD
               IF OBJ = '' THEN OBJ = '*'
            END
            CALL PC.SUB(OBJ)
*
            IF Q.OPT THEN
               IF LINE.NO(1) > 2 THEN
                  IF LEN(OBJ) > 25 THEN
                     FOR I = 1 TO NO.BAD.INCL UNTIL INDEX(O.OBJ,BAD.INCL.LIST<1,I>,1)
                     NEXT I
                     IF I > NO.BAD.INCL THEN
                        INCL.ID = 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
                        WRITE OBJ ON DEST.FD , INCL.ID
                        INCL.NO = INCL.NO + 1
                        OBJ = INCLUDE.STR : ' ' : INCL.ID
                     END
                  END
               END
            END
            IF INDEX(OBJ,CHAR(240),1) THEN
               INCL.ID = 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
               WRITE CONVERT(CHAR(240),CHAR(254),OBJ) ON DEST.FD , INCL.ID
               INCL.NO = INCL.NO + 1
               OBJ = INCLUDE.STR : ' ' : INCL.ID
            END
      END CASE
*
      IF NOT(MOD(LINE.NO(RECUR.LEVEL),25) OR OBJ = '*') AND OOBJ2 <> '' THEN
         OOBJ<-1> = OOBJ2
         OOBJ2 = ''
      END
*
*----------------------------------------------------------------------
* This section of code is only for those machines that support
* the BASIC CHAIN operator.  This allows the pre-compiler to generate
* code that is greater than 32K.
*
      IF OBJ = '*' THEN
         IF CHAIN.OPT THEN
            IF LEN(OOBJ) > 22000 AND LINE.CNT(RECUR.LEVEL) <> NO.LINES THEN
               OOBJ<-1> = CHAIN.STR : ' ' : 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
               IF NOT(CHAIN.FLG) THEN
                  WRITE OOBJ ON DEST.FD , OBJ.NAME
               END ELSE
                  WRITE OOBJ ON DEST.FD , 'INCL.' : PORT : '.' : PGM.NO : '.' : INCL.NO
                  INCL.NO = INCL.NO + 1
               END
               OOBJ = ''
               CHAIN.FLG = 1
            END ELSE
               OOBJ2<-1> = '*'
            END
         END ELSE
            OOBJ2<-1> = '*'
         END
      END ELSE
         OOBJ2<-1> = OBJ
      END
*----------------------------------------------------------------------
*
      IF NOT(MOD(LINE.NO(RECUR.LEVEL),10)) OR LINE.NO(RECUR.LEVEL) = NO.LINES THEN
         IF RECUR.LEVEL = 1 THEN
            PRINT CR : LINE.NO(1) 'R#4' :
         END ELSE
            PRINT CR : LINE.NO(1) 'R#4' : ' ' : LINE.NO(RECUR.LEVEL) 'R#4' :
         END
      END
*
      RETURN
*
1000 REM CHANGE OBJECT CODE FILE
*
      IF SYNTAX.FILE = '' THEN SYNTAX.FILE = SYNTAX.FILE.DEF
*
      PRINT CR : LINE.NO(1) 'R#4' : SPACE(6) : PGM.NO 'R#3' : ' ' : PGM.ID 'L#30' : ( ' Pass 1  ' : SYNTAX.FILE ) 'L#30' :
*
      OPEN SYNTAX.FILE TO OBJ.FD ELSE STOP 201,SYNTAX.FILE
*
      READ KW.F FROM OBJ.FD , 'KW*F' ELSE KW.F = ''
      READ KW.S FROM OBJ.FD , 'KW*S' ELSE KW.S = ''
      KW.FC = DCOUNT(KW.F,VM)
      KW.SC = DCOUNT(KW.S,VM)
*
      READ KW.A FROM OBJ.FD , 'KW*' ELSE KW.A = ''
      KW.AC = DCOUNT(KW.A,AM)
*
      READ N.F FROM OBJ.FD , '*F' ELSE N.F = ''
      READ N.S FROM OBJ.FD , '*S' ELSE N.S = ''
*
      READ C.STR FROM OBJ.FD , '*COMMON' ELSE C.STR = ''
      READ I.STR FROM OBJ.FD , '*INIT' ELSE I.STR = ''
*
      RETURN
*
      CW = '(C) Copyright 1985-1989 Modular Software.  All rights reserved.'
   END
